[commit: ghc] master: nativeGen: Use `foldl'` instead of `foldr` in free register accumulation (efc8e3b)
git at git.haskell.org
git at git.haskell.org
Tue Jan 24 21:07:53 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/efc8e3b17bd374c5860081bd7350a1ce7c7cb92f/ghc
>---------------------------------------------------------------
commit efc8e3b17bd374c5860081bd7350a1ce7c7cb92f
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Tue Jan 24 12:51:26 2017 -0500
nativeGen: Use `foldl'` instead of `foldr` in free register accumulation
Manipulations of `FreeRegs` values are all just bit-operations on a
word. Turning these `foldr`s into `foldl'`s has a very small but consistent
effect on compiler allocations,
```
-1 s.d. ----- -0.065%
+1 s.d. ----- -0.018%
Average ----- -0.042%
```
Test Plan: Validate
Reviewers: austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2966
>---------------------------------------------------------------
efc8e3b17bd374c5860081bd7350a1ce7c7cb92f
compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs | 3 ++-
compiler/nativeGen/RegAlloc/Linear/Main.hs | 5 +++--
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs | 4 ++--
compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 4 ++--
compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs | 3 ++-
compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs | 3 ++-
6 files changed, 13 insertions(+), 9 deletions(-)
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 0b65537..186ff3f 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -25,6 +25,7 @@ import Unique
import UniqFM
import UniqSet
+import Data.Foldable (foldl')
-- | For a jump instruction at the end of a block, generate fixup code so its
-- vregs are in the correct regs for its destination.
@@ -128,7 +129,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
-- free up the regs that are not live on entry to this block.
freeregs <- getFreeRegsR
- let freeregs' = foldr (frReleaseReg platform) freeregs to_free
+ let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free
-- remember the current assignment on entry to this block.
setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 4db02d6..0551297 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -351,7 +351,8 @@ initBlock id block_live
Nothing ->
setFreeRegsR (frInitFreeRegs platform)
Just live ->
- setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- nonDetEltsUFM live ]
+ setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
+ [ r | RegReal r <- nonDetEltsUFM live ]
-- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
@@ -685,7 +686,7 @@ clobberRegs clobbered
let platform = targetPlatform dflags
freeregs <- getFreeRegsR
- setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered
+ setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered
assig <- getAssigR
setAssigR $! clobber assig (nonDetUFMToList assig)
diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
index a2a6dac..5d36924 100644
--- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
@@ -11,7 +11,7 @@ import Platform
import Data.Word
import Data.Bits
--- import Data.List
+import Data.Foldable (foldl')
-- The PowerPC has 32 integer and 32 floating point registers.
-- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
@@ -39,7 +39,7 @@ releaseReg _ _
= panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
initFreeRegs :: Platform -> FreeRegs
-initFreeRegs platform = foldr releaseReg noFreeRegs (allocatableRegs platform)
+initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs cls (FreeRegs g f)
diff --git a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
index 89a9407..db4d6ba 100644
--- a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
@@ -13,7 +13,7 @@ import Platform
import Data.Word
import Data.Bits
--- import Data.List
+import Data.Foldable (foldl')
--------------------------------------------------------------------------------
@@ -45,7 +45,7 @@ noFreeRegs = FreeRegs 0 0 0
-- | The initial set of free regs.
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
- = foldr (releaseReg platform) noFreeRegs allocatableRegs
+ = foldl' (flip $ releaseReg platform) noFreeRegs allocatableRegs
-- | Get all the free registers of this class.
diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
index 0fcd658..ae4aa53 100644
--- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
@@ -11,6 +11,7 @@ import Platform
import Data.Word
import Data.Bits
+import Data.Foldable (foldl')
newtype FreeRegs = FreeRegs Word32
deriving Show
@@ -27,7 +28,7 @@ releaseReg _ _
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
- = foldr releaseReg noFreeRegs (allocatableRegs platform)
+ = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
diff --git a/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
index c04fce9..5a7f71e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
@@ -9,6 +9,7 @@ import Reg
import Panic
import Platform
+import Data.Foldable (foldl')
import Data.Word
import Data.Bits
@@ -27,7 +28,7 @@ releaseReg _ _
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
- = foldr releaseReg noFreeRegs (allocatableRegs platform)
+ = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
More information about the ghc-commits
mailing list