Minor cleanup of foldRegs{Used,Defd}
authorMichal Terepeta <michal.terepeta@gmail.com>
Tue, 29 Nov 2016 18:31:28 +0000 (13:31 -0500)
committerBen Gamari <ben@smart-cactus.org>
Tue, 29 Nov 2016 19:39:55 +0000 (14:39 -0500)
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@gmail.com>
Test Plan: validate

Reviewers: simonmar, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2723

compiler/cmm/CmmExpr.hs
compiler/cmm/CmmNode.hs

index 985db0e..bb610a0 100644 (file)
@@ -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
index bba9bd7..1103fdb 100644 (file)
@@ -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