Make getDynFlags* functions use HasDynFlags/getDynFlags too

8 files changed, 40 insertions, 42 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index bdb411e5f4..f56238fd12 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -843,8 +843,8 @@ instance Monad CmmOptM where
 addImportCmmOpt :: CLabel -> CmmOptM ()
 addImportCmmOpt lbl = CmmOptM $ \(imports, _dflags) -> (# (), lbl:imports #)
 
-getDynFlagsCmmOpt :: CmmOptM DynFlags
-getDynFlagsCmmOpt = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
+instance HasDynFlags CmmOptM where
+    getDynFlags = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
 
 runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel])
 runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of
@@ -895,7 +895,7 @@ cmmStmtConFold stmt
 
         CmmCondBranch test dest
            -> do test' <- cmmExprConFold DataReference test
-                 dflags <- getDynFlagsCmmOpt
+                 dflags <- getDynFlags
                  let platform = targetPlatform dflags
 	         return $ case test' of
 		   CmmLit (CmmInt 0 _) -> 
@@ -914,7 +914,7 @@ cmmStmtConFold stmt
 
 cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
 cmmExprConFold referenceKind expr = do
-    dflags <- getDynFlagsCmmOpt
+    dflags <- getDynFlags
     -- Skip constant folding if new code generator is running
     -- (this optimization is done in Hoopl)
     let expr' = if dopt Opt_TryNewCodeGen dflags
@@ -932,7 +932,7 @@ cmmExprCon _ other = other
 -- of things to do.
 cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
 cmmExprNative referenceKind expr = do
-     dflags <- getDynFlagsCmmOpt
+     dflags <- getDynFlags
      let platform = targetPlatform dflags
          arch = platformArch platform
      case expr of
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 71250a2452..eb59d2b82a 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -29,7 +29,7 @@ module NCGMonad (
 	getNewRegPairNat,
 	getPicBaseMaybeNat, 
 	getPicBaseNat, 
-	getDynFlagsNat
+	getDynFlags
 ) 
  
 where
@@ -100,11 +100,9 @@ getUniqueNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
     case takeUniqFromSupply us of
          (uniq, us') -> (uniq, (NatM_State us' delta imports pic dflags))
 
-
-getDynFlagsNat :: NatM DynFlags
-getDynFlagsNat 
-	= NatM $ \ (NatM_State us delta imports pic dflags) ->
-	          (dflags, (NatM_State us delta imports pic dflags))
+instance HasDynFlags NatM where
+    getDynFlags = NatM $ \ (NatM_State us delta imports pic dflags) ->
+                             (dflags, (NatM_State us delta imports pic dflags))
 
 
 getDeltaNat :: NatM Int
@@ -139,14 +137,14 @@ getNewLabelNat
 getNewRegNat :: Size -> NatM Reg
 getNewRegNat rep
  = do u <- getUniqueNat
-      dflags <- getDynFlagsNat
+      dflags <- getDynFlags
       return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)
 
 
 getNewRegPairNat :: Size -> NatM (Reg,Reg)
 getNewRegPairNat rep
  = do u <- getUniqueNat
-      dflags <- getDynFlagsNat
+      dflags <- getDynFlags
       let vLo = targetMkVirtualReg (targetPlatform dflags) u rep
       let lo  = RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep
       let hi  = RegVirtual $ getHiVirtualRegFromLo vLo
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index a043af01f8..2fd11bc35a 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -73,7 +73,7 @@ cmmTopCodeGen
 cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dflags
@@ -114,7 +114,7 @@ stmtsToInstrs stmts
 
 stmtToInstrs :: CmmStmt -> NatM InstrBlock
 stmtToInstrs stmt = do
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   case stmt of
     CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
@@ -357,13 +357,13 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
     return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
                          rlo
 iselExpr64 expr
-   = do dflags <- getDynFlagsNat
+   = do dflags <- getDynFlags
         pprPanic "iselExpr64(powerpc)" (pprPlatform (targetPlatform dflags) expr)
 
 
 
 getRegister :: CmmExpr -> NatM Register
-getRegister e = do dflags <- getDynFlagsNat
+getRegister e = do dflags <- getDynFlags
                    getRegister' dflags e
 
 getRegister' :: DynFlags -> CmmExpr -> NatM Register
@@ -555,7 +555,7 @@ getRegister' _ (CmmLit (CmmInt i rep))
 
 getRegister' _ (CmmLit (CmmFloat f frep)) = do
     lbl <- getNewLabelNat
-    dflags <- getDynFlagsNat
+    dflags <- getDynFlags
     dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let size = floatSize frep
@@ -845,7 +845,7 @@ genCCall :: CmmCallTarget            -- function to call
          -> [HintedCmmActual]        -- arguments (of mixed type)
          -> NatM InstrBlock
 genCCall target dest_regs argsAndHints
- = do dflags <- getDynFlagsNat
+ = do dflags <- getDynFlags
       case platformOS (targetPlatform dflags) of
           OSLinux    -> genCCall' GCPLinux  target dest_regs argsAndHints
           OSDarwin   -> genCCall' GCPDarwin target dest_regs argsAndHints
@@ -1098,7 +1098,7 @@ genCCall' gcp target dest_regs argsAndHints
 
         outOfLineMachOp mop =
             do
-                dflags <- getDynFlagsNat
+                dflags <- getDynFlags
                 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
                               mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
                 let mopLabelOrExpr = case mopExpr of
@@ -1162,7 +1162,7 @@ genSwitch expr ids
         (reg,e_code) <- getSomeReg expr
         tmp <- getNewRegNat II32
         lbl <- getNewLabelNat
-        dflags <- getDynFlagsNat
+        dflags <- getDynFlags
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let code = e_code `appOL` t_code `appOL` toOL [
@@ -1364,7 +1364,7 @@ coerceInt2FP fromRep toRep x = do
     lbl <- getNewLabelNat
     itmp <- getNewRegNat II32
     ftmp <- getNewRegNat FF64
-    dflags <- getDynFlagsNat
+    dflags <- getDynFlags
     dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 663b95b236..ff1e9f2eb2 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -63,7 +63,7 @@ cmmTopCodeGen :: RawCmmDecl
 
 cmmTopCodeGen (CmmProc info lab (ListGraph blocks))
  = do
-      dflags <- getDynFlagsNat
+      dflags <- getDynFlags
       let platform = targetPlatform dflags
       (nat_blocks,statics) <- mapAndUnzipM (basicBlockCodeGen platform) blocks
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
index 48c766f8e0..91351a2e18 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
@@ -141,7 +141,7 @@ genCCall target dest_regs argsAndHints
         let transfer_code
                 = toOL (move_final vregs allArgRegs extraStackArgsHere)
                                 
-        dflags <- getDynFlagsNat
+        dflags <- getDynFlags
         return 
          $      argcode                 `appOL`
                 move_sp_down            `appOL`
@@ -276,7 +276,7 @@ outOfLineMachOp mop
  = do   let functionName
                 = outOfLineMachOp_table mop
         
-        dflags  <- getDynFlagsNat
+        dflags  <- getDynFlags
         mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference 
                 $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index 215a565ba6..f02b7a45a8 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -62,10 +62,10 @@ getCondCode (CmmMachOp mop [x, y])
       MO_U_Lt _   -> condIntCode LU   x y
       MO_U_Le _   -> condIntCode LEU  x y
 
-      _           -> do dflags <- getDynFlagsNat
+      _           -> do dflags <- getDynFlags
                         pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
 
-getCondCode other = do dflags <- getDynFlagsNat
+getCondCode other = do dflags <- getDynFlags
                        pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) other)
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 5bcab2cb10..5352281296 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -190,7 +190,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
 	-- compute expr and load it into r_dst_lo
 	(a_reg, a_code)	<- getSomeReg expr
 
-	dflags <- getDynFlagsNat
+	dflags <- getDynFlags
 	let platform = targetPlatform dflags
 	    code	= a_code
 		`appOL`	toOL
@@ -201,7 +201,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
 
 
 iselExpr64 expr
-   = do dflags <- getDynFlagsNat
+   = do dflags <- getDynFlags
         pprPanic "iselExpr64(sparc)" (pprPlatform (targetPlatform dflags) expr)
 
 
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 5f0f716281..2ade04d36f 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -63,12 +63,12 @@ import Data.Word
 
 is32BitPlatform :: NatM Bool
 is32BitPlatform = do
-    dflags <- getDynFlagsNat
+    dflags <- getDynFlags
     return $ target32Bit (targetPlatform dflags)
 
 sse2Enabled :: NatM Bool
 sse2Enabled = do
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   case platformArch (targetPlatform dflags) of
       ArchX86_64 -> -- SSE2 is fixed on for x86_64.  It would be
                     -- possible to make it optional, but we'd need to
@@ -81,7 +81,7 @@ sse2Enabled = do
 
 sse4_2Enabled :: NatM Bool
 sse4_2Enabled = do
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   return (dopt Opt_SSE4_2 dflags)
 
 if_sse2 :: NatM a -> NatM a -> NatM a
@@ -96,7 +96,7 @@ cmmTopCodeGen
 cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dflags
@@ -400,7 +400,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do
             )
 
 iselExpr64 expr
-   = do dflags <- getDynFlagsNat
+   = do dflags <- getDynFlags
         pprPanic "iselExpr64(i386)" (pprPlatform (targetPlatform dflags) expr)
 
 
@@ -887,7 +887,7 @@ getRegister' _ (CmmLit lit)
     in
         return (Any size code)
 
-getRegister' _ other = do dflags <- getDynFlagsNat
+getRegister' _ other = do dflags <- getDynFlags
                           pprPanic "getRegister(x86)" (pprPlatform (targetPlatform dflags) other)
 
 
@@ -1131,7 +1131,7 @@ isOperand _ _            = False
 memConstant :: Int -> CmmLit -> NatM Amode
 memConstant align lit = do
   lbl <- getNewLabelNat
-  dflags <- getDynFlagsNat
+  dflags <- getDynFlags
   (addr, addr_code) <- if target32Bit (targetPlatform dflags)
                        then do dynRef <- cmmMakeDynamicReference
                                              dflags
@@ -1228,10 +1228,10 @@ getCondCode (CmmMachOp mop [x, y])
       MO_U_Lt _ -> condIntCode LU  x y
       MO_U_Le _ -> condIntCode LEU x y
 
-      _other -> do dflags <- getDynFlagsNat
+      _other -> do dflags <- getDynFlags
                    pprPanic "getCondCode(x86,x86_64,sparc)" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
 
-getCondCode other = do dflags <- getDynFlagsNat
+getCondCode other = do dflags <- getDynFlags
                        pprPanic "getCondCode(2)(x86,sparc)" (pprPlatform (targetPlatform dflags) other)
 
 
@@ -1621,7 +1621,7 @@ genCCall is32Bit (CmmPrim (MO_PopCnt width)) dest_regs@[CmmHinted dst _]
                          unitOL (POPCNT size (OpReg src_r)
                                  (getRegisterReg False (CmmLocal dst))))
         else do
-            dflags <- getDynFlagsNat
+            dflags <- getDynFlags
             targetExpr <- cmmMakeDynamicReference dflags addImportNat
                           CallReference lbl
             let target = CmmCallee targetExpr CCallConv
@@ -1959,7 +1959,7 @@ genCCall64 target dest_regs args =
              (arg_reg, arg_code) <- getSomeReg arg
              delta <- getDeltaNat
              setDeltaNat (delta-arg_size)
-             dflags <- getDynFlagsNat
+             dflags <- getDynFlags
              let platform = targetPlatform dflags
                  code' = code `appOL` arg_code `appOL` toOL [
                             SUB (intSize wordWidth) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
@@ -1992,7 +1992,7 @@ maxInlineSizeThreshold = 128
 outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> [HintedCmmActual] -> NatM InstrBlock
 outOfLineCmmOp mop res args
   = do
-      dflags <- getDynFlagsNat
+      dflags <- getDynFlags
       targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
       let target = CmmCallee targetExpr CCallConv
 
@@ -2063,7 +2063,7 @@ genSwitch expr ids
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        dflags <- getDynFlagsNat
+        dflags <- getDynFlags
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)