X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=3fd5e441a65e9a54764a2a0829376430b24f67b5;hb=d76b6a05ab36066e8aeb67d58e25992d1ef83a8a;hp=db5accd3c05ba6f255e4219efaa3e1381f2d3c89;hpb=fd8d04119e849f9c713d3e697228846d93c5ca69;p=ghc-hetmet.git diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index db5accd..3fd5e44 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -1,7 +1,3 @@ -{-# OPTIONS -fno-warn-name-shadowing -w #-} --- We'd like to use -fno-warn-orphans rather than -w, but old compilers --- don't understand it so building stage1 fails. - ----------------------------------------------------------------------------- -- -- Cmm data types @@ -22,11 +18,13 @@ module Cmm ( CmmReturnInfo(..), CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind, CmmFormalsWithoutKinds, CmmFormalWithoutKind, + CmmHinted(..), CmmSafety(..), CmmCallTarget(..), CmmStatic(..), Section(..), module CmmExpr, - BlockId(..), freshBlockId, + + BlockId(..), mkBlockId, BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, ) where @@ -44,7 +42,7 @@ import FastString import Data.Word -import ZipCfg ( BlockId(..), freshBlockId +import ZipCfg ( BlockId(..), mkBlockId , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet ) @@ -243,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 @@ -253,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 @@ -274,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 ~~~~~~~~~~