X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=3fd5e441a65e9a54764a2a0829376430b24f67b5;hb=235edf36cc202bb21c00d0e5e05ebf076fb0542e;hp=b535c8dbd221dbdee492794678c6b63560599dc3;hpb=c92fecad2314baf305292174a14ba383465157a4;p=ghc-hetmet.git

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index b535c8d..3fd5e44 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -18,9 +18,11 @@ module Cmm (
         CmmReturnInfo(..),
 	CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
         CmmFormalsWithoutKinds, CmmFormalWithoutKind,
+        CmmHinted(..),
         CmmSafety(..),
 	CmmCallTarget(..),
 	CmmStatic(..), Section(..),
+        module CmmExpr,
 
         BlockId(..), mkBlockId,
         BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv,
@@ -239,8 +241,10 @@ data CmmStmt
       CmmActuals         -- with these return values.
 
 type CmmKind   = MachHint
-type CmmActual = (CmmExpr, CmmKind)
-type CmmFormal = (LocalReg,CmmKind)
+data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: CmmKind }
+                         deriving (Eq)
+type CmmActual = CmmHinted CmmExpr
+type CmmFormal = CmmHinted LocalReg
 type CmmActuals = [CmmActual]
 type CmmFormals = [CmmFormal]
 type CmmFormalWithoutKind   = LocalReg
@@ -249,8 +253,8 @@ type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]
 data CmmSafety      = CmmUnsafe | CmmSafe C_SRT
 
 -- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
-instance UserOfLocalRegs a => UserOfLocalRegs (a, CmmKind) where
-  foldRegsUsed f set (a, _) = foldRegsUsed f set a
+instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
+  foldRegsUsed f set (CmmHinted a _) = foldRegsUsed f set a
 
 instance UserOfLocalRegs CmmStmt where
   foldRegsUsed f set s = stmt s set
@@ -270,6 +274,11 @@ instance UserOfLocalRegs CmmCallTarget where
     foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
     foldRegsUsed _ set (CmmPrim {})    = set
 
+--just look like a tuple, since it was a tuple before
+-- ... is that a good idea? --Isaac Dupree
+instance (Outputable a) => Outputable (CmmHinted a) where
+  ppr (CmmHinted a k) = ppr (a, k)
+
 {-
 Discussion
 ~~~~~~~~~~