X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FNCGMonad.hs;h=d19cda45f407b8342a2f7929da8ef7c9a74a2451;hb=1353826e5159c9a5a81e75e0b7459271f27c08ea;hp=8fdcd44024fb99e462319f58a41e46155996511d;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 8fdcd44..d19cda4 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -13,32 +13,33 @@ module NCGMonad (
 	initNat, addImportNat, getUniqueNat,
 	mapAccumLNat, setDeltaNat, getDeltaNat,
 	getBlockIdNat, getNewLabelNat, getNewRegNat, getNewRegPairNat,
-	getPicBaseMaybeNat, getPicBaseNat
+	getPicBaseMaybeNat, getPicBaseNat, getDynFlagsNat
  ) where
   
 #include "HsVersions.h"
 
-import Cmm		( BlockId(..) )
+import BlockId
 import CLabel		( CLabel, mkAsmTempLabel )
-import MachRegs
-import MachOp		( MachRep )
+import Regs
 import UniqSupply
 import Unique		( Unique )
-
+import DynFlags
 
 data NatM_State = NatM_State {
 			natm_us      :: UniqSupply,
 			natm_delta   :: Int,
 			natm_imports :: [(CLabel)],
-			natm_pic     :: Maybe Reg
+			natm_pic     :: Maybe Reg,
+			natm_dflags  :: DynFlags
 		}
 
 newtype NatM result = NatM (NatM_State -> (result, NatM_State))
 
+unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
 
-mkNatM_State :: UniqSupply -> Int -> NatM_State
-mkNatM_State us delta = NatM_State us delta [] Nothing
+mkNatM_State :: UniqSupply -> Int -> DynFlags -> NatM_State
+mkNatM_State us delta dflags = NatM_State us delta [] Nothing dflags
 
 initNat :: NatM_State -> NatM a -> (a, NatM_State)
 initNat init_st m = case unNat m init_st of { (r,st) -> (r,st) }
@@ -60,7 +61,7 @@ mapAccumLNat :: (acc -> x -> NatM (acc, y))
 	        -> [x]
 	        -> NatM (acc, [y])
 
-mapAccumLNat f b []
+mapAccumLNat _ b []
   = return (b, [])
 mapAccumLNat f b (x:xs)
   = do (b__2, x__2)  <- f b x
@@ -68,20 +69,25 @@ mapAccumLNat f b (x:xs)
        return (b__3, x__2:xs__2)
 
 getUniqueNat :: NatM Unique
-getUniqueNat = NatM $ \ (NatM_State us delta imports pic) ->
+getUniqueNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
     case splitUniqSupply us of
-         (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports pic))
+         (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports pic dflags))
+
+
+getDynFlagsNat :: NatM DynFlags
+getDynFlagsNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
+		          (dflags, (NatM_State us delta imports pic dflags))
 
 getDeltaNat :: NatM Int
 getDeltaNat = NatM $ \ st -> (natm_delta st, st)
 
 setDeltaNat :: Int -> NatM ()
-setDeltaNat delta = NatM $ \ (NatM_State us _ imports pic) ->
-   ((), NatM_State us delta imports pic)
+setDeltaNat delta = NatM $ \ (NatM_State us _ imports pic dflags) ->
+   ((), NatM_State us delta imports pic dflags)
 
 addImportNat :: CLabel -> NatM ()
-addImportNat imp = NatM $ \ (NatM_State us delta imports pic) -> 
-   ((), NatM_State us delta (imp:imports) pic)
+addImportNat imp = NatM $ \ (NatM_State us delta imports pic dflags) ->
+   ((), NatM_State us delta (imp:imports) pic dflags)
 
 getBlockIdNat :: NatM BlockId
 getBlockIdNat = do u <- getUniqueNat; return (BlockId u)
@@ -89,10 +95,10 @@ getBlockIdNat = do u <- getUniqueNat; return (BlockId u)
 getNewLabelNat :: NatM CLabel
 getNewLabelNat = do u <- getUniqueNat; return (mkAsmTempLabel u)
 
-getNewRegNat :: MachRep -> NatM Reg
+getNewRegNat :: Size -> NatM Reg
 getNewRegNat rep = do u <- getUniqueNat; return (mkVReg u rep)
 
-getNewRegPairNat :: MachRep -> NatM (Reg,Reg)
+getNewRegPairNat :: Size -> NatM (Reg,Reg)
 getNewRegPairNat rep = do 
   u <- getUniqueNat
   let lo = mkVReg u rep; hi = getHiVRegFromLo lo
@@ -101,7 +107,7 @@ getNewRegPairNat rep = do
 getPicBaseMaybeNat :: NatM (Maybe Reg)
 getPicBaseMaybeNat = NatM (\state -> (natm_pic state, state))
 
-getPicBaseNat :: MachRep -> NatM Reg
+getPicBaseNat :: Size -> NatM Reg
 getPicBaseNat rep = do
   mbPicBase <- getPicBaseMaybeNat
   case mbPicBase of