[commit: ghc] master: Minor cleanup of foldRegs{Used,Defd} (da5a61e)
git at git.haskell.org
git at git.haskell.org
Tue Nov 29 19:40:12 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/da5a61eb15237d406e4d1fb4390d47602ee4c34c/ghc
>---------------------------------------------------------------
commit da5a61eb15237d406e4d1fb4390d47602ee4c34c
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date: Tue Nov 29 13:31:28 2016 -0500
Minor cleanup of foldRegs{Used,Defd}
This makes the two functions strict in the accumulator - it seems that
there are only two users of those functions: `CmmLive` and `CmmSink`
and in both cases the strict fold fits better.
The commit also removes a few unused functions (`filterRegsUsed`),
instances (for `Maybe` and `RegSet`) and gets rid of unnecessary
inculde of `HsVersions.h`.
The performance effect of avoiding unnecessary thunks is mostly
negligible, although we do allocate a tiny bit less (nofib's section
on compile allocations):
```
-1 s.d. ----- -0.2%
+1 s.d. ----- -0.1%
Average ----- -0.2%
```
Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>
Test Plan: validate
Reviewers: simonmar, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2723
>---------------------------------------------------------------
da5a61eb15237d406e4d1fb4390d47602ee4c34c
compiler/cmm/CmmExpr.hs | 33 ++++++++-------------------------
compiler/cmm/CmmNode.hs | 33 +++++++++++++++------------------
2 files changed, 23 insertions(+), 43 deletions(-)
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 985db0e..bb610a0 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -13,7 +14,7 @@ module CmmExpr
, VGcPtr(..)
, DefinerOfRegs, UserOfRegs
- , foldRegsDefd, foldRegsUsed, filterRegsUsed
+ , foldRegsDefd, foldRegsUsed
, foldLocalRegsDefd, foldLocalRegsUsed
, RegSet, LocalRegSet, GlobalRegSet
@@ -27,8 +28,6 @@ module CmmExpr
)
where
-#include "HsVersions.h"
-
import BlockId
import CLabel
import CmmMachOp
@@ -38,6 +37,7 @@ import Outputable (panic)
import Unique
import Data.Set (Set)
+import Data.List
import qualified Data.Set as Set
-----------------------------------------------------------------------------
@@ -318,12 +318,6 @@ foldLocalRegsDefd :: DefinerOfRegs LocalReg a
=> DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsDefd = foldRegsDefd
-filterRegsUsed :: UserOfRegs r e => DynFlags -> (r -> Bool) -> e -> RegSet r
-filterRegsUsed dflags p e =
- foldRegsUsed dflags
- (\regs r -> if p r then extendRegSet regs r else regs)
- emptyRegSet e
-
instance UserOfRegs LocalReg CmmReg where
foldRegsUsed _ f z (CmmLocal reg) = f z reg
foldRegsUsed _ _ z (CmmGlobal _) = z
@@ -346,13 +340,10 @@ instance Ord r => UserOfRegs r r where
instance Ord r => DefinerOfRegs r r where
foldRegsDefd _ f z r = f z r
-instance Ord r => UserOfRegs r (RegSet r) where
- foldRegsUsed _ f = Set.fold (flip f)
-
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
-- The (Ord r) in the context is necessary here
-- See Note [Recursive superclasses] in TcInstDcls
- foldRegsUsed dflags f z e = expr z e
+ foldRegsUsed dflags f !z e = expr z e
where expr z (CmmLit _) = z
expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr
expr z (CmmReg r) = foldRegsUsed dflags f z r
@@ -360,21 +351,13 @@ instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
expr z (CmmRegOff r _) = foldRegsUsed dflags f z r
expr z (CmmStackSlot _ _) = z
-instance UserOfRegs r a => UserOfRegs r (Maybe a) where
- foldRegsUsed dflags f z (Just x) = foldRegsUsed dflags f z x
- foldRegsUsed _ _ z Nothing = z
-
instance UserOfRegs r a => UserOfRegs r [a] where
- foldRegsUsed _ _ set [] = set
- foldRegsUsed dflags f set (x:xs) = foldRegsUsed dflags f (foldRegsUsed dflags f set x) xs
+ foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as
+ {-# INLINABLE foldRegsUsed #-}
instance DefinerOfRegs r a => DefinerOfRegs r [a] where
- foldRegsDefd _ _ set [] = set
- foldRegsDefd dflags f set (x:xs) = foldRegsDefd dflags f (foldRegsDefd dflags f set x) xs
-
-instance DefinerOfRegs r a => DefinerOfRegs r (Maybe a) where
- foldRegsDefd _ _ set Nothing = set
- foldRegsDefd dflags f set (Just x) = foldRegsDefd dflags f set x
+ foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as
+ {-# INLINABLE foldRegsDefd #-}
-----------------------------------------------------------------------------
-- Global STG registers
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index bba9bd7..1103fdb 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -308,7 +309,7 @@ foreignTargetHints target
-- Instances of register and slot users / definers
instance UserOfRegs LocalReg (CmmNode e x) where
- foldRegsUsed dflags f z n = case n of
+ foldRegsUsed dflags f !z n = case n of
CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval
CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
@@ -317,13 +318,12 @@ instance UserOfRegs LocalReg (CmmNode e x) where
CmmCall {cml_target=tgt} -> fold f z tgt
CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
_ -> z
- where fold :: forall a b.
- UserOfRegs LocalReg a =>
- (b -> LocalReg -> b) -> b -> a -> b
+ where fold :: forall a b. UserOfRegs LocalReg a
+ => (b -> LocalReg -> b) -> b -> a -> b
fold f z n = foldRegsUsed dflags f z n
instance UserOfRegs GlobalReg (CmmNode e x) where
- foldRegsUsed dflags f z n = case n of
+ foldRegsUsed dflags f !z n = case n of
CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval
CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
@@ -332,39 +332,36 @@ instance UserOfRegs GlobalReg (CmmNode e x) where
CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt
CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
_ -> z
- where fold :: forall a b.
- UserOfRegs GlobalReg a =>
- (b -> GlobalReg -> b) -> b -> a -> b
+ where fold :: forall a b. UserOfRegs GlobalReg a
+ => (b -> GlobalReg -> b) -> b -> a -> b
fold f z n = foldRegsUsed dflags f z n
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where
-- The (Ord r) in the context is necessary here
-- See Note [Recursive superclasses] in TcInstDcls
- foldRegsUsed _ _ z (PrimTarget _) = z
- foldRegsUsed dflags f z (ForeignTarget e _) = foldRegsUsed dflags f z e
+ foldRegsUsed _ _ !z (PrimTarget _) = z
+ foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e
instance DefinerOfRegs LocalReg (CmmNode e x) where
- foldRegsDefd dflags f z n = case n of
+ foldRegsDefd dflags f !z n = case n of
CmmAssign lhs _ -> fold f z lhs
CmmUnsafeForeignCall _ fs _ -> fold f z fs
CmmForeignCall {res=res} -> fold f z res
_ -> z
- where fold :: forall a b.
- DefinerOfRegs LocalReg a =>
- (b -> LocalReg -> b) -> b -> a -> b
+ where fold :: forall a b. DefinerOfRegs LocalReg a
+ => (b -> LocalReg -> b) -> b -> a -> b
fold f z n = foldRegsDefd dflags f z n
instance DefinerOfRegs GlobalReg (CmmNode e x) where
- foldRegsDefd dflags f z n = case n of
+ foldRegsDefd dflags f !z n = case n of
CmmAssign lhs _ -> fold f z lhs
CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt)
CmmCall {} -> fold f z activeRegs
CmmForeignCall {} -> fold f z activeRegs
-- See Note [Safe foreign calls clobber STG registers]
_ -> z
- where fold :: forall a b.
- DefinerOfRegs GlobalReg a =>
- (b -> GlobalReg -> b) -> b -> a -> b
+ where fold :: forall a b. DefinerOfRegs GlobalReg a
+ => (b -> GlobalReg -> b) -> b -> a -> b
fold f z n = foldRegsDefd dflags f z n
platform = targetPlatform dflags
More information about the ghc-commits
mailing list