Commit da5a61eb authored by Michal Terepeta's avatar Michal Terepeta Committed by Ben Gamari

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's avatarMichal Terepeta <michal.terepeta@gmail.com>

Test Plan: validate

Reviewers: simonmar, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2723
parent 52222f9b
{-# 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
......
{-# 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment