diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2014-07-31 09:30:18 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2014-08-01 12:45:41 +0100 |
| commit | 3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079 (patch) | |
| tree | 0e53a96d154a4594cbea03c33c600dee98ef5f9b /compiler/nativeGen/RegAlloc | |
| parent | 52188ada67e0f90425e52202541f78eccdcee35b (diff) | |
| download | haskell-3b9fe0c61bc3cd7ded3a03b6be714d5c791ce079.tar.gz | |
refactor to fix 80column overflow
Diffstat (limited to 'compiler/nativeGen/RegAlloc')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/Main.hs | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 35416926ed..fa47a17ac0 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) |