From e3d1ba74f7b1ec4ea7463aab783265b4baaf3366 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 29 Jul 2010 15:26:11 +0000 Subject: [PATCH] Add two local type signatures --- compiler/cmm/Cmm.hs | 28 ++++++++++++++++------------ compiler/cmm/PprCmm.hs | 2 ++ 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 5c02622..9c9f410 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -258,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 diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 1160273..a9df2b9 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -265,6 +265,8 @@ pprStmt stmt = case stmt of pp_lhs | null results = empty | otherwise = commafy (map ppr_ar results) <+> equals -- Don't print the hints on a native C-- call + + ppr_ar :: Outputable a => CmmHinted a -> SDoc ppr_ar (CmmHinted ar k) = case cconv of CmmCallConv -> ppr ar _ -> ppr (ar,k) -- 1.7.10.4