summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/RegAlloc/Linear/State.hs
diff options
context:
space:
mode:
authorIan Lynagh <ian@well-typed.com>2012-09-14 19:39:28 +0100
committerIan Lynagh <ian@well-typed.com>2012-09-14 19:39:28 +0100
commit2e3c925564b6c08bb187c747c806ccd2528ccbb9 (patch)
tree219cc24fa56eafb04544b78a3a4c94d6b96766f3 /compiler/nativeGen/RegAlloc/Linear/State.hs
parent2115585f6aa1fc0e4560563fcda2fd1f7a09a5d4 (diff)
downloadhaskell-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.hs19
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