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

6 files changed, 13 insertions, 9 deletions

diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 0b655374a5..186ff3f622 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 4db02d6dee..055129703b 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 a2a6dacb65..5d369249c7 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 89a9407b71..db4d6ba376 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 0fcd658120..ae4aa53254 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 c04fce9645..5a7f71e3f0 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