[commit: ghc] master: refactor to fix 80column overflow (3b9fe0c)

git at git.haskell.org git at git.haskell.org
Fri Aug 1 11:46:05 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079/ghc

>---------------------------------------------------------------

commit 3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Jul 31 09:30:18 2014 +0100

    refactor to fix 80column overflow


>---------------------------------------------------------------

3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079
 compiler/nativeGen/RegAlloc/Linear/Main.hs | 36 +++++++++++++++++-------------
 1 file changed, 20 insertions(+), 16 deletions(-)

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 3541692..fa47a17 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -196,26 +196,30 @@ regAlloc _ (CmmProc _ _ _ _)
 linearRegAlloc
         :: (Outputable instr, Instruction instr)
         => DynFlags
-        -> [BlockId]                    -- ^ entry points
-        -> BlockMap RegSet              -- ^ live regs on entry to each basic block
-        -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
+        -> [BlockId] -- ^ entry points
+        -> BlockMap RegSet
+              -- ^ live regs on entry to each basic block
+        -> [SCC (LiveBasicBlock instr)]
+              -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
 
 linearRegAlloc dflags entry_ids block_live sccs
- = let platform = targetPlatform dflags
-   in case platformArch platform of
-      ArchX86       -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86.FreeRegs)    entry_ids block_live sccs
-      ArchX86_64    -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86_64.FreeRegs) entry_ids block_live sccs
-      ArchSPARC     -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs)  entry_ids block_live sccs
-      ArchPPC       -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs)    entry_ids block_live sccs
-      ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
-      ArchARM64     -> panic "linearRegAlloc ArchARM64"
-      ArchPPC_64    -> panic "linearRegAlloc ArchPPC_64"
-      ArchAlpha     -> panic "linearRegAlloc ArchAlpha"
-      ArchMipseb    -> panic "linearRegAlloc ArchMipseb"
-      ArchMipsel    -> panic "linearRegAlloc ArchMipsel"
+ = case platformArch platform of
+      ArchX86        -> go $ (frInitFreeRegs platform :: X86.FreeRegs)
+      ArchX86_64     -> go $ (frInitFreeRegs platform :: X86_64.FreeRegs)
+      ArchSPARC      -> go $ (frInitFreeRegs platform :: SPARC.FreeRegs)
+      ArchPPC        -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)
+      ArchARM _ _ _  -> panic "linearRegAlloc ArchARM"
+      ArchARM64      -> panic "linearRegAlloc ArchARM64"
+      ArchPPC_64     -> panic "linearRegAlloc ArchPPC_64"
+      ArchAlpha      -> panic "linearRegAlloc ArchAlpha"
+      ArchMipseb     -> panic "linearRegAlloc ArchMipseb"
+      ArchMipsel     -> panic "linearRegAlloc ArchMipsel"
       ArchJavaScript -> panic "linearRegAlloc ArchJavaScript"
-      ArchUnknown   -> panic "linearRegAlloc ArchUnknown"
+      ArchUnknown    -> panic "linearRegAlloc ArchUnknown"
+ where
+  go f = linearRegAlloc' dflags f entry_ids block_live sccs
+  platform = targetPlatform dflags
 
 linearRegAlloc'
         :: (FR freeRegs, Outputable instr, Instruction instr)



More information about the ghc-commits mailing list