X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=9c9f41051e095b6055f7268c3b63dfa9c91db8b4;hb=7fc01c4671980ea3c66d549c0ece4d82fd3f5ade;hp=c48269ecf51c70f387a1520929a254bab3ba4bf0;hpb=787b08bdea84cca4bf9490d87c059453bffc5ad2;p=ghc-hetmet.git diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index c48269e..9c9f410 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -181,6 +181,7 @@ data ClosureTypeInfo data CmmReturnInfo = CmmMayReturn | CmmNeverReturns + deriving ( Eq ) -- TODO: These types may need refinement data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc @@ -257,18 +258,22 @@ data CmmSafety = CmmUnsafe | CmmSafe C_SRT -- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals' instance UserOfLocalRegs CmmStmt where - foldRegsUsed f set s = stmt s set - where stmt (CmmNop) = id - stmt (CmmComment {}) = id - stmt (CmmAssign _ e) = gen e - stmt (CmmStore e1 e2) = gen e1 . gen e2 - stmt (CmmCall target _ es _ _) = gen target . gen es - stmt (CmmBranch _) = id - stmt (CmmCondBranch e _) = gen e - stmt (CmmSwitch e _) = gen e - stmt (CmmJump e es) = gen e . gen es - stmt (CmmReturn es) = gen es - gen a set = foldRegsUsed f set a + foldRegsUsed f (set::b) s = stmt s set + where + stmt :: CmmStmt -> b -> b + stmt (CmmNop) = id + stmt (CmmComment {}) = id + stmt (CmmAssign _ e) = gen e + stmt (CmmStore e1 e2) = gen e1 . gen e2 + stmt (CmmCall target _ es _ _) = gen target . gen es + stmt (CmmBranch _) = id + stmt (CmmCondBranch e _) = gen e + stmt (CmmSwitch e _) = gen e + stmt (CmmJump e es) = gen e . gen es + stmt (CmmReturn es) = gen es + + gen :: UserOfLocalRegs a => a -> b -> b + gen a set = foldRegsUsed f set a instance UserOfLocalRegs CmmCallTarget where foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e