diff options
| author | Ian Lynagh <ian@well-typed.com> | 2012-09-14 19:39:28 +0100 |
|---|---|---|
| committer | Ian Lynagh <ian@well-typed.com> | 2012-09-14 19:39:28 +0100 |
| commit | 2e3c925564b6c08bb187c747c806ccd2528ccbb9 (patch) | |
| tree | 219cc24fa56eafb04544b78a3a4c94d6b96766f3 /compiler/nativeGen/RegAlloc/Linear/State.hs | |
| parent | 2115585f6aa1fc0e4560563fcda2fd1f7a09a5d4 (diff) | |
| download | haskell-2e3c925564b6c08bb187c747c806ccd2528ccbb9.tar.gz | |
Put DynFlags into the RegM monad
Also moved the type definition into RegAlloc.Linear.State to de-orphan
the Monad instance.
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Linear/State.hs')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/State.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs index 57b899111e..433bb05821 100644 --- a/compiler/nativeGen/RegAlloc/Linear/State.hs +++ b/compiler/nativeGen/RegAlloc/Linear/State.hs @@ -3,8 +3,6 @@ -- Here we keep all the state that the register allocator keeps track -- of as it walks the instructions in a basic block. -{-# OPTIONS_GHC -fno-warn-orphans #-} - module RegAlloc.Linear.State ( RA_State(..), RegM, @@ -38,19 +36,29 @@ import RegAlloc.Liveness import Instruction import Reg +import DynFlags import Platform import Unique import UniqSupply +-- | The register allocator monad type. +newtype RegM freeRegs a + = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) } + + -- | The RegM Monad instance Monad (RegM freeRegs) where m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s } return a = RegM $ \s -> (# s, a #) +instance HasDynFlags (RegM a) where + getDynFlags = RegM $ \s -> (# s, ra_DynFlags s #) + -- | Run a computation in the RegM register allocator monad. -runR :: BlockAssignment freeRegs +runR :: DynFlags + -> BlockAssignment freeRegs -> freeRegs -> RegMap Loc -> StackMap @@ -58,7 +66,7 @@ runR :: BlockAssignment freeRegs -> RegM freeRegs a -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a) -runR block_assig freeregs assig stack us thing = +runR dflags block_assig freeregs assig stack us thing = case unReg thing (RA_State { ra_blockassig = block_assig @@ -67,7 +75,8 @@ runR block_assig freeregs assig stack us thing = , ra_delta = 0{-???-} , ra_stack = stack , ra_us = us - , ra_spills = [] }) + , ra_spills = [] + , ra_DynFlags = dflags }) of (# state'@RA_State { ra_blockassig = block_assig |