Move tARGET_* out of HaskellConstants

24 files changed, 399 insertions, 306 deletions

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index 8fbcbb7a88..220ef9edd1 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -52,6 +52,7 @@ import FastString
 import BasicTypes
 import Binary
 import Constants
+import DynFlags
 import UniqFM
 import Util
 
@@ -216,14 +217,14 @@ instance Ord Literal where
         ~~~~~~~~~~~~
 \begin{code}
 -- | Creates a 'Literal' of type @Int#@
-mkMachInt :: Integer -> Literal
-mkMachInt  x   = ASSERT2( inIntRange x,  integer x )
-                 MachInt x
+mkMachInt :: DynFlags -> Integer -> Literal
+mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
+                       MachInt x
 
 -- | Creates a 'Literal' of type @Word#@
-mkMachWord :: Integer -> Literal
-mkMachWord x   = ASSERT2( inWordRange x, integer x )
-                 MachWord x
+mkMachWord :: DynFlags -> Integer -> Literal
+mkMachWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
+                        MachWord x
 
 -- | Creates a 'Literal' of type @Int64#@
 mkMachInt64 :: Integer -> Literal
@@ -254,9 +255,9 @@ mkMachString s = MachStr (fastStringToFastBytes $ mkFastString s)
 mkLitInteger :: Integer -> Type -> Literal
 mkLitInteger = LitInteger
 
-inIntRange, inWordRange :: Integer -> Bool
-inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
-inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
+inIntRange, inWordRange :: DynFlags -> Integer -> Bool
+inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
+inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags
 
 inCharRange :: Char -> Bool
 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
@@ -275,23 +276,23 @@ isZeroLit _              = False
         Coercions
         ~~~~~~~~~
 \begin{code}
-word2IntLit, int2WordLit,
-  narrow8IntLit, narrow16IntLit, narrow32IntLit,
+narrow8IntLit, narrow16IntLit, narrow32IntLit,
   narrow8WordLit, narrow16WordLit, narrow32WordLit,
   char2IntLit, int2CharLit,
   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
   float2DoubleLit, double2FloatLit
   :: Literal -> Literal
 
-word2IntLit (MachWord w)
-  | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
-  | otherwise          = MachInt w
-word2IntLit l = pprPanic "word2IntLit" (ppr l)
+word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
+word2IntLit dflags (MachWord w)
+  | w > tARGET_MAX_INT dflags = MachInt (w - tARGET_MAX_WORD dflags - 1)
+  | otherwise                 = MachInt w
+word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
 
-int2WordLit (MachInt i)
-  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
+int2WordLit dflags (MachInt i)
+  | i < 0     = MachWord (1 + tARGET_MAX_WORD dflags + i)      -- (-1)  --->  tARGET_MAX_WORD
   | otherwise = MachWord i
-int2WordLit l = pprPanic "int2WordLit" (ppr l)
+int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
 
 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 narrow8IntLit    l            = pprPanic "narrow8IntLit" (ppr l)
@@ -343,11 +344,11 @@ litIsTrivial _                = True
 
 -- | True if code space does not go bad if we duplicate this literal
 -- Currently we treat it just like 'litIsTrivial'
-litIsDupable :: Literal -> Bool
+litIsDupable :: DynFlags -> Literal -> Bool
 --      c.f. CoreUtils.exprIsDupable
-litIsDupable (MachStr _)      = False
-litIsDupable (LitInteger i _) = inIntRange i
-litIsDupable _                = True
+litIsDupable _      (MachStr _)      = False
+litIsDupable dflags (LitInteger i _) = inIntRange dflags i
+litIsDupable _      _                = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (MachInt i)
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 0bd199ff18..fda2bccf9a 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -471,7 +471,7 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
 cpeRhsE _env expr@(Type {})      = return (emptyFloats, expr)
 cpeRhsE _env expr@(Coercion {})  = return (emptyFloats, expr)
 cpeRhsE env (Lit (LitInteger i _))
-    = cpeRhsE env (cvtLitInteger (getMkIntegerId env) i)
+    = cpeRhsE env (cvtLitInteger (cpe_dynFlags env) (getMkIntegerId env) i)
 cpeRhsE _env expr@(Lit {})       = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})        = cpeApp env expr
 
@@ -521,16 +521,16 @@ cpeRhsE env (Case scrut bndr ty alts)
             ; rhs' <- cpeBodyNF env2 rhs
             ; return (con, bs', rhs') }
 
-cvtLitInteger :: Id -> Integer -> CoreExpr
+cvtLitInteger :: DynFlags -> Id -> Integer -> CoreExpr
 -- Here we convert a literal Integer to the low-level
 -- represenation. Exactly how we do this depends on the
 -- library that implements Integer.  If it's GMP we
 -- use the S# data constructor for small literals.
 -- See Note [Integer literals] in Literal
-cvtLitInteger mk_integer i
+cvtLitInteger dflags mk_integer i
   | cIntegerLibraryType == IntegerGMP
-  , inIntRange i       -- Special case for small integers in GMP
-    = mkConApp integerGmpSDataCon [Lit (mkMachInt i)]
+  , inIntRange dflags i       -- Special case for small integers in GMP
+    = mkConApp integerGmpSDataCon [Lit (mkMachInt dflags i)]
 
   | otherwise
     = mkApps (Var mk_integer) [isNonNegative, ints]
@@ -540,7 +540,7 @@ cvtLitInteger mk_integer i
         f 0 = []
         f x = let low  = x .&. mask
                   high = x `shiftR` bits
-              in mkConApp intDataCon [Lit (mkMachInt low)] : f high
+              in mkConApp intDataCon [Lit (mkMachInt dflags low)] : f high
         bits = 31
         mask = 2 ^ bits - 1
 
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index e9a044e951..2fb5aafd61 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -1118,23 +1118,23 @@ mkConApp con args = mkApps (Var (dataConWorkId con)) args
 
 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
-mkIntLit      :: Integer -> Expr b
+mkIntLit      :: DynFlags -> Integer -> Expr b
 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
-mkIntLitInt   :: Int     -> Expr b
+mkIntLitInt   :: DynFlags -> Int     -> Expr b
 
-mkIntLit    n = Lit (mkMachInt n)
-mkIntLitInt n = Lit (mkMachInt (toInteger n))
+mkIntLit    dflags n = Lit (mkMachInt dflags n)
+mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
 
 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
-mkWordLit     :: Integer -> Expr b
+mkWordLit     :: DynFlags -> Integer -> Expr b
 -- | Create a machine word literal expression of type  @Word#@ from a @Word@.
 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
-mkWordLitWord :: Word -> Expr b
+mkWordLitWord :: DynFlags -> Word -> Expr b
 
-mkWordLit     w = Lit (mkMachWord w)
-mkWordLitWord w = Lit (mkMachWord (toInteger w))
+mkWordLit     dflags w = Lit (mkMachWord dflags w)
+mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
 
 mkWord64LitWord64 :: Word64 -> Expr b
 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index f15c648694..cad80128b9 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -64,6 +64,7 @@ import TyCon
 import Unique
 import Outputable
 import TysPrim
+import DynFlags
 import FastString
 import Maybes
 import Platform
@@ -602,8 +603,8 @@ Note [exprIsDupable]
 
 
 \begin{code}
-exprIsDupable :: CoreExpr -> Bool
-exprIsDupable e
+exprIsDupable :: DynFlags -> CoreExpr -> Bool
+exprIsDupable dflags e
   = isJust (go dupAppSize e)
   where
     go :: Int -> CoreExpr -> Maybe Int
@@ -613,7 +614,7 @@ exprIsDupable e
     go n (Tick _ e)    = go n e
     go n (Cast e _)    = go n e
     go n (App f a) | Just n' <- go n a = go n' f
-    go n (Lit lit) | litIsDupable lit = decrement n
+    go n (Lit lit) | litIsDupable dflags lit = decrement n
     go _ _ = Nothing
 
     decrement :: Int -> Maybe Int
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 0857cd556e..e903ab2084 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -84,6 +84,7 @@ import BasicTypes
 import Util
 import Pair
 import Constants
+import DynFlags
 
 import Data.Char        ( ord )
 import Data.List
@@ -233,20 +234,20 @@ mkCoreLams = mkLams
 
 \begin{code}
 -- | Create a 'CoreExpr' which will evaluate to the given @Int@
-mkIntExpr      :: Integer    -> CoreExpr            -- Result = I# i :: Int
-mkIntExpr  i = mkConApp intDataCon  [mkIntLit i]
+mkIntExpr :: DynFlags -> Integer -> CoreExpr        -- Result = I# i :: Int
+mkIntExpr dflags i = mkConApp intDataCon  [mkIntLit dflags i]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Int@
-mkIntExprInt   :: Int        -> CoreExpr            -- Result = I# i :: Int
-mkIntExprInt  i = mkConApp intDataCon  [mkIntLitInt i]
+mkIntExprInt :: DynFlags -> Int -> CoreExpr         -- Result = I# i :: Int
+mkIntExprInt dflags i = mkConApp intDataCon  [mkIntLitInt dflags i]
 
 -- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value
-mkWordExpr     :: Integer    -> CoreExpr
-mkWordExpr w = mkConApp wordDataCon [mkWordLit w]
+mkWordExpr :: DynFlags -> Integer -> CoreExpr
+mkWordExpr dflags w = mkConApp wordDataCon [mkWordLit dflags w]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Word@
-mkWordExprWord :: Word       -> CoreExpr
-mkWordExprWord w = mkConApp wordDataCon [mkWordLitWord w]
+mkWordExprWord :: DynFlags -> Word -> CoreExpr
+mkWordExprWord dflags w = mkConApp wordDataCon [mkWordLitWord dflags w]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
 mkIntegerExpr  :: MonadThings m => Integer -> m CoreExpr  -- Result :: Integer
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index e02ef7b385..b5e38c8af2 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -149,11 +149,12 @@ unboxArg arg
   -- Booleans
   | Just tc <- tyConAppTyCon_maybe arg_ty, 
     tc `hasKey` boolTyConKey
-  = do prim_arg <- newSysLocalDs intPrimTy
+  = do dflags <- getDynFlags
+       prim_arg <- newSysLocalDs intPrimTy
        return (Var prim_arg,
               \ body -> Case (mkWildCase arg arg_ty intPrimTy
-                                       [(DataAlt falseDataCon,[],mkIntLit 0),
-                                        (DataAlt trueDataCon, [],mkIntLit 1)])
+                                       [(DataAlt falseDataCon,[],mkIntLit dflags 0),
+                                        (DataAlt trueDataCon, [],mkIntLit dflags 1)])
                                         -- In increasing tag order!
                              prim_arg
                              (exprType body) 
@@ -335,11 +336,13 @@ resultWrapper result_ty
 
   -- Base case 3: the boolean type
   | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey
-  = return
+  = do
+    dflags <- getDynFlags
+    return
      (Just intPrimTy, \e -> mkWildCase e intPrimTy
                                    boolTy
-                                   [(DEFAULT             ,[],Var trueDataConId ),
-                                    (LitAlt (mkMachInt 0),[],Var falseDataConId)])
+                                   [(DEFAULT                    ,[],Var trueDataConId ),
+                                    (LitAlt (mkMachInt dflags 0),[],Var falseDataConId)])
 
   -- Recursive newtypes
   | Just (rep_ty, co) <- splitNewTypeRepCo_maybe result_ty
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index cc6b6afada..0cf4b97159 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -430,7 +430,7 @@ dsFExportDynamic id co0 cconv = do
           to be entered using an external calling convention
           (stdcall, ccall).
          -}
-        adj_args      = [ mkIntLitInt (ccallConvToInt cconv)
+        adj_args      = [ mkIntLitInt dflags (ccallConvToInt cconv)
                         , Var stbl_value
                         , Lit (MachLabel fe_nm mb_sz_args IsFunction)
                         , Lit (mkMachString typestring)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 874f8b0f41..15dab47ca1 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -62,6 +62,7 @@ import Unique
 import BasicTypes
 import Outputable
 import Bag
+import DynFlags
 import FastString
 import ForeignCall
 import MonadUtils
@@ -798,7 +799,8 @@ repTy (HsTyLit lit) = do
 repTy ty		      = notHandled "Exotic form of type" (ppr ty)
 
 repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
-repTyLit (HsNumTy i) = rep2 numTyLitName [mkIntExpr i]
+repTyLit (HsNumTy i) = do dflags <- getDynFlags
+                          rep2 numTyLitName [mkIntExpr dflags i]
 repTyLit (HsStrTy s) = do { s' <- mkStringExprFS s
                          ; rep2 strTyLitName [s']
                          }
@@ -1730,11 +1732,13 @@ repNamedTyCon (MkC s) = rep2 conTName [s]
 
 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
 -- Note: not Core Int; it's easier to be direct here
-repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
+repTupleTyCon i = do dflags <- getDynFlags
+                     rep2 tupleTName [mkIntExprInt dflags i]
 
 repUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
 -- Note: not Core Int; it's easier to be direct here
-repUnboxedTupleTyCon i = rep2 unboxedTupleTName [mkIntExprInt i]
+repUnboxedTupleTyCon i = do dflags <- getDynFlags
+                            rep2 unboxedTupleTName [mkIntExprInt dflags i]
 
 repArrowTyCon :: DsM (Core TH.TypeQ)
 repArrowTyCon = rep2 arrowTName []
@@ -1746,7 +1750,8 @@ repPromotedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
 repPromotedTyCon (MkC s) = rep2 promotedTName [s]
 
 repPromotedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
-repPromotedTupleTyCon i = rep2 promotedTupleTName [mkIntExprInt i]
+repPromotedTupleTyCon i = do dflags <- getDynFlags
+                             rep2 promotedTupleTName [mkIntExprInt dflags i]
 
 repPromotedNilTyCon :: DsM (Core TH.TypeQ)
 repPromotedNilTyCon = rep2 promotedNilTName []
@@ -1769,7 +1774,8 @@ repKCon :: Core TH.Name -> DsM (Core TH.Kind)
 repKCon (MkC s) = rep2 conKName [s]
 
 repKTuple :: Int -> DsM (Core TH.Kind)
-repKTuple i = rep2 tupleKName [mkIntExprInt i]
+repKTuple i = do dflags <- getDynFlags
+                 rep2 tupleKName [mkIntExprInt dflags i]
 
 repKArrow :: DsM (Core TH.Kind)
 repKArrow = rep2 arrowKName []
@@ -1878,7 +1884,8 @@ coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
 ------------ Literals & Variables -------------------
 
 coreIntLit :: Int -> DsM (Core Int)
-coreIntLit i = return (MkC (mkIntExprInt i))
+coreIntLit i = do dflags <- getDynFlags
+                  return (MkC (mkIntExprInt dflags i))
 
 coreVar :: Id -> Core TH.Name	-- The Id has type Name
 coreVar id = MkC (Var id)
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 52944e8347..0053484b13 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -308,11 +308,12 @@ mkCoPrimCaseMatchResult var ty match_alts
 
 
 mkCoAlgCaseMatchResult 
-  :: Id					   -- Scrutinee
+  :: DynFlags
+  -> Id					   -- Scrutinee
   -> Type                                  -- Type of exp
   -> [(DataCon, [CoreBndr], MatchResult)]  -- Alternatives (bndrs *include* tyvars, dicts)
   -> MatchResult
-mkCoAlgCaseMatchResult var ty match_alts 
+mkCoAlgCaseMatchResult dflags var ty match_alts 
   | isNewTyCon tycon		-- Newtype case; use a let
   = ASSERT( null (tail match_alts) && null (tail arg_ids1) )
     mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
@@ -423,7 +424,7 @@ mkCoAlgCaseMatchResult var ty match_alts
 	    lit   = MachInt $ toInteger (dataConSourceArity con)
 	    binds = [NonRec arg (indexExpr i) | (i, arg) <- zip [1..] args]
 	    --
-	    indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr i]
+	    indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr dflags i]
 \end{code}
 
 %************************************************************************
diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 8fd3a203f3..adb9099c14 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -292,12 +292,13 @@ match [] ty eqns
 
 match vars@(v:_) ty eqns
   = ASSERT( not (null eqns ) )
-    do	{ 	-- Tidy the first pattern, generating
+    do	{ dflags <- getDynFlags
+      	; 	-- Tidy the first pattern, generating
 		-- auxiliary bindings if necessary
           (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
 
 		-- Group the equations and match each group in turn
-        ; let grouped = groupEquations tidy_eqns
+        ; let grouped = groupEquations dflags tidy_eqns
 
          -- print the view patterns that are commoned up to help debug
         ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
@@ -787,13 +788,13 @@ data PatGroup
                         -- the LHsExpr is the expression e
            Type         -- the Type is the type of p (equivalently, the result type of e)
 
-groupEquations :: [EquationInfo] -> [[(PatGroup, EquationInfo)]]
+groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]
 -- If the result is of form [g1, g2, g3], 
 -- (a) all the (pg,eq) pairs in g1 have the same pg
 -- (b) none of the gi are empty
 -- The ordering of equations is unchanged
-groupEquations eqns
-  = runs same_gp [(patGroup (firstPat eqn), eqn) | eqn <- eqns]
+groupEquations dflags eqns
+  = runs same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
   where
     same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
     (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
@@ -948,16 +949,16 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     eq_co (TcTyConAppCo tc1 cos1) (TcTyConAppCo tc2 cos2) = tc1==tc2 && eq_list eq_co cos1 cos2
     eq_co _ _ = False
 
-patGroup :: Pat Id -> PatGroup
-patGroup (WildPat {})       	      = PgAny
-patGroup (BangPat {})       	      = PgBang  
-patGroup (ConPatOut { pat_con = dc }) = PgCon (unLoc dc)
-patGroup (LitPat lit)		      = PgLit (hsLitKey lit)
-patGroup (NPat olit mb_neg _)	      = PgN   (hsOverLitKey olit (isJust mb_neg))
-patGroup (NPlusKPat _ olit _ _)	      = PgNpK (hsOverLitKey olit False)
-patGroup (CoPat _ p _)		      = PgCo  (hsPatType p)	-- Type of innelexp pattern
-patGroup (ViewPat expr p _)               = PgView expr (hsPatType (unLoc p))
-patGroup pat = pprPanic "patGroup" (ppr pat)
+patGroup :: DynFlags -> Pat Id -> PatGroup
+patGroup _      (WildPat {})                 = PgAny
+patGroup _      (BangPat {})                 = PgBang
+patGroup _      (ConPatOut { pat_con = dc }) = PgCon (unLoc dc)
+patGroup dflags (LitPat lit)                 = PgLit (hsLitKey dflags lit)
+patGroup _      (NPat olit mb_neg _)         = PgN   (hsOverLitKey olit (isJust mb_neg))
+patGroup _      (NPlusKPat _ olit _ _)       = PgNpK (hsOverLitKey olit False)
+patGroup _      (CoPat _ p _)                = PgCo  (hsPatType p) -- Type of innelexp pattern
+patGroup _      (ViewPat expr p _)           = PgView expr (hsPatType (unLoc p))
+patGroup _      pat = pprPanic "patGroup" (ppr pat)
 \end{code}
 
 Note [Grouping overloaded literal patterns]
diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
index e1b2ef83df..10270e50ca 100644
--- a/compiler/deSugar/MatchCon.lhs
+++ b/compiler/deSugar/MatchCon.lhs
@@ -31,6 +31,7 @@ import ListSetOps ( runs )
 import Id
 import NameEnv
 import SrcLoc
+import DynFlags
 import Outputable
 import Control.Monad(liftM)
 \end{code}
@@ -92,8 +93,9 @@ matchConFamily :: [Id]
 	       -> DsM MatchResult
 -- Each group of eqns is for a single constructor
 matchConFamily (var:vars) ty groups
-  = do	{ alts <- mapM (matchOneCon vars ty) groups
-	; return (mkCoAlgCaseMatchResult var ty alts) }
+  = do dflags <- getDynFlags
+       alts <- mapM (matchOneCon vars ty) groups
+       return (mkCoAlgCaseMatchResult dflags var ty alts)
 matchConFamily [] _ _ = panic "matchConFamily []"
 
 type ConArgPats = HsConDetails (LPat Id) (HsRecFields Id (LPat Id))
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 4032093541..69d46c2096 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -42,6 +42,7 @@ import Data.Ratio
 import MonadUtils
 import Outputable
 import BasicTypes
+import DynFlags
 import Util
 import FastString
 \end{code}
@@ -81,7 +82,8 @@ dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d)))
 dsLit (HsChar c)       = return (mkCharExpr c)
 dsLit (HsString str)   = mkStringExprFS str
 dsLit (HsInteger i _)  = mkIntegerExpr i
-dsLit (HsInt i)	       = return (mkIntExpr i)
+dsLit (HsInt i)        = do dflags <- getDynFlags
+                            return (mkIntExpr dflags i)
 
 dsLit (HsRat r ty) = do
    num   <- mkIntegerExpr (numerator (fl_value r))
@@ -95,12 +97,16 @@ dsLit (HsRat r ty) = do
                 x -> pprPanic "dsLit" (ppr x)
 
 dsOverLit :: HsOverLit Id -> DsM CoreExpr
+dsOverLit lit = do dflags <- getDynFlags
+                   dsOverLit' dflags lit
+
+dsOverLit' :: DynFlags -> HsOverLit Id -> DsM CoreExpr
 -- Post-typechecker, the SyntaxExpr field of an OverLit contains 
 -- (an expression for) the literal value itself
-dsOverLit (OverLit { ol_val = val, ol_rebindable = rebindable 
-		   , ol_witness = witness, ol_type = ty })
+dsOverLit' dflags (OverLit { ol_val = val, ol_rebindable = rebindable
+                           , ol_witness = witness, ol_type = ty })
   | not rebindable
-  , Just expr <- shortCutLit val ty = dsExpr expr	-- Note [Literal short cut]
+  , Just expr <- shortCutLit dflags val ty = dsExpr expr	-- Note [Literal short cut]
   | otherwise			    = dsExpr witness
 \end{code}
 
@@ -113,22 +119,22 @@ much better do do so.
 
 
 \begin{code}
-hsLitKey :: HsLit -> Literal
+hsLitKey :: DynFlags -> HsLit -> Literal
 -- Get a Core literal to use (only) a grouping key
 -- Hence its type doesn't need to match the type of the original literal
 --	(and doesn't for strings)
 -- It only works for primitive types and strings; 
 -- others have been removed by tidy
-hsLitKey (HsIntPrim     i) = mkMachInt  i
-hsLitKey (HsWordPrim    w) = mkMachWord w
-hsLitKey (HsInt64Prim   i) = mkMachInt64  i
-hsLitKey (HsWord64Prim  w) = mkMachWord64 w
-hsLitKey (HsCharPrim    c) = MachChar   c
-hsLitKey (HsStringPrim  s) = MachStr    s
-hsLitKey (HsFloatPrim   f) = MachFloat  (fl_value f)
-hsLitKey (HsDoublePrim  d) = MachDouble (fl_value d)
-hsLitKey (HsString s)      = MachStr    (fastStringToFastBytes s)
-hsLitKey l                 = pprPanic "hsLitKey" (ppr l)
+hsLitKey dflags (HsIntPrim     i) = mkMachInt  dflags i
+hsLitKey dflags (HsWordPrim    w) = mkMachWord dflags w
+hsLitKey _      (HsInt64Prim   i) = mkMachInt64  i
+hsLitKey _      (HsWord64Prim  w) = mkMachWord64 w
+hsLitKey _      (HsCharPrim    c) = MachChar   c
+hsLitKey _      (HsStringPrim  s) = MachStr    s
+hsLitKey _      (HsFloatPrim   f) = MachFloat  (fl_value f)
+hsLitKey _      (HsDoublePrim  d) = MachDouble (fl_value d)
+hsLitKey _      (HsString s)      = MachStr    (fastStringToFastBytes s)
+hsLitKey _      l                 = pprPanic "hsLitKey" (ppr l)
 
 hsOverLitKey :: OutputableBndr a => HsOverLit a -> Bool -> Literal
 -- Ditto for HsOverLit; the boolean indicates to negate
@@ -247,9 +253,10 @@ matchLiterals (var:vars) ty sub_groups
   where
     match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
     match_group eqns
-	= do { let LitPat hs_lit = firstPat (head eqns)
-	     ; match_result <- match vars ty (shiftEqns eqns)
-	     ; return (hsLitKey hs_lit, match_result) }
+        = do dflags <- getDynFlags
+             let LitPat hs_lit = firstPat (head eqns)
+             match_result <- match vars ty (shiftEqns eqns)
+             return (hsLitKey dflags hs_lit, match_result)
 
     wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
 	-- Equality check for string literals
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d4c3d535d6..70ade2ad78 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -122,6 +122,7 @@ module DynFlags (
         wORD_SIZE_IN_BITS,
         tAG_MASK,
         mAX_PTR_TAG,
+        tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
   ) where
 
 #include "HsVersions.h"
@@ -155,11 +156,13 @@ import Control.Monad
 
 import Data.Bits
 import Data.Char
+import Data.Int
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Word
 import System.FilePath
 import System.IO
 
@@ -3162,3 +3165,21 @@ tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1
 mAX_PTR_TAG :: DynFlags -> Int
 mAX_PTR_TAG = tAG_MASK
 
+-- Might be worth caching these in targetPlatform?
+tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: DynFlags -> Integer
+tARGET_MIN_INT dflags
+    = case platformWordSize (targetPlatform dflags) of
+      4 -> toInteger (minBound :: Int32)
+      8 -> toInteger (minBound :: Int64)
+      w -> panic ("tARGET_MIN_INT: Unknown platformWordSize: " ++ show w)
+tARGET_MAX_INT dflags
+    = case platformWordSize (targetPlatform dflags) of
+      4 -> toInteger (maxBound :: Int32)
+      8 -> toInteger (maxBound :: Int64)
+      w -> panic ("tARGET_MAX_INT: Unknown platformWordSize: " ++ show w)
+tARGET_MAX_WORD dflags
+    = case platformWordSize (targetPlatform dflags) of
+      4 -> toInteger (maxBound :: Word32)
+      8 -> toInteger (maxBound :: Word64)
+      w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
+
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ffd5de809d..309f2e2d9b 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -1238,7 +1238,7 @@ hasCafRefs dflags this_pkg p arity expr
   | is_caf || mentions_cafs = MayHaveCafRefs
   | otherwise               = NoCafRefs
  where
-  mentions_cafs = isFastTrue (cafRefsE p expr)
+  mentions_cafs = isFastTrue (cafRefsE dflags p expr)
   is_dynamic_name = isDllName dflags this_pkg
   is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name expr)
 
@@ -1248,28 +1248,28 @@ hasCafRefs dflags this_pkg p arity expr
   -- CorePrep later on, and we don't want to duplicate that
   -- knowledge in rhsIsStatic below.
 
-cafRefsE :: (Id, VarEnv Id) -> Expr a -> FastBool
-cafRefsE p (Var id)            = cafRefsV p id
-cafRefsE p (Lit lit)           = cafRefsL p lit
-cafRefsE p (App f a)           = fastOr (cafRefsE p f) (cafRefsE p) a
-cafRefsE p (Lam _ e)           = cafRefsE p e
-cafRefsE p (Let b e)           = fastOr (cafRefsEs p (rhssOfBind b)) (cafRefsE p) e
-cafRefsE p (Case e _bndr _ alts) = fastOr (cafRefsE p e) (cafRefsEs p) (rhssOfAlts alts)
-cafRefsE p (Tick _n e)         = cafRefsE p e
-cafRefsE p (Cast e _co)        = cafRefsE p e
-cafRefsE _ (Type _)            = fastBool False
-cafRefsE _ (Coercion _)        = fastBool False
-
-cafRefsEs :: (Id, VarEnv Id) -> [Expr a] -> FastBool
-cafRefsEs _ []    = fastBool False
-cafRefsEs p (e:es) = fastOr (cafRefsE p e) (cafRefsEs p) es
-
-cafRefsL :: (Id, VarEnv Id) -> Literal -> FastBool
+cafRefsE :: DynFlags -> (Id, VarEnv Id) -> Expr a -> FastBool
+cafRefsE _      p (Var id)            = cafRefsV p id
+cafRefsE dflags p (Lit lit)           = cafRefsL dflags p lit
+cafRefsE dflags p (App f a)           = fastOr (cafRefsE dflags p f) (cafRefsE dflags p) a
+cafRefsE dflags p (Lam _ e)           = cafRefsE dflags p e
+cafRefsE dflags p (Let b e)           = fastOr (cafRefsEs dflags p (rhssOfBind b)) (cafRefsE dflags p) e
+cafRefsE dflags p (Case e _bndr _ alts) = fastOr (cafRefsE dflags p e) (cafRefsEs dflags p) (rhssOfAlts alts)
+cafRefsE dflags p (Tick _n e)         = cafRefsE dflags p e
+cafRefsE dflags p (Cast e _co)        = cafRefsE dflags p e
+cafRefsE _      _ (Type _)            = fastBool False
+cafRefsE _      _ (Coercion _)        = fastBool False
+
+cafRefsEs :: DynFlags -> (Id, VarEnv Id) -> [Expr a] -> FastBool
+cafRefsEs _      _ []     = fastBool False
+cafRefsEs dflags p (e:es) = fastOr (cafRefsE dflags p e) (cafRefsEs dflags p) es
+
+cafRefsL :: DynFlags -> (Id, VarEnv Id) -> Literal -> FastBool
 -- Don't forget that mk_integer id might have Caf refs!
 -- We first need to convert the Integer into its final form, to
 -- see whether mkInteger is used.
-cafRefsL p@(mk_integer, _) (LitInteger i _) = cafRefsE p (cvtLitInteger mk_integer i)
-cafRefsL _ _                         = fastBool False
+cafRefsL dflags p@(mk_integer, _) (LitInteger i _) = cafRefsE dflags p (cvtLitInteger dflags mk_integer i)
+cafRefsL _      _ _                         = fastBool False
 
 cafRefsV :: (Id, VarEnv Id) -> Id -> FastBool
 cafRefsV (_, p) id
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 2e09e03446..0d4229fb7b 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -80,60 +80,61 @@ primOpRules nm DataToTagOp = mkPrimOpRule nm 2 [ dataToTagRule ]
 
 -- Int operations
 primOpRules nm IntAddOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (+))
-                                               , identity zeroi ]
+                                               , identityDynFlags zeroi ]
 primOpRules nm IntSubOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (-))
-                                               , rightIdentity zeroi
-                                               , equalArgs >> return (Lit zeroi) ]
+                                               , rightIdentityDynFlags zeroi
+                                               , equalArgs >> retLit zeroi ]
 primOpRules nm IntMulOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (*))
                                                , zeroElem zeroi
-                                               , identity onei ]
+                                               , identityDynFlags onei ]
 primOpRules nm IntQuotOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot)
                                                , leftZero zeroi
-                                               , rightIdentity onei
-                                               , equalArgs >> return (Lit onei) ]
+                                               , rightIdentityDynFlags onei
+                                               , equalArgs >> retLit onei ]
 primOpRules nm IntRemOp    = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 rem)
                                                , leftZero zeroi
                                                , do l <- getLiteral 1
-                                                    guard (l == onei)
-                                                    return (Lit zeroi)
-                                               , equalArgs >> return (Lit zeroi)
-                                               , equalArgs >> return (Lit zeroi) ]
+                                                    dflags <- getDynFlags
+                                                    guard (l == onei dflags)
+                                                    retLit zeroi
+                                               , equalArgs >> retLit zeroi
+                                               , equalArgs >> retLit zeroi ]
 primOpRules nm IntNegOp    = mkPrimOpRule nm 1 [ unaryLit negOp ]
 primOpRules nm ISllOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 Bits.shiftL)
-                                               , rightIdentity zeroi ]
+                                               , rightIdentityDynFlags zeroi ]
 primOpRules nm ISraOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 Bits.shiftR)
-                                               , rightIdentity zeroi ]
+                                               , rightIdentityDynFlags zeroi ]
 primOpRules nm ISrlOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 shiftRightLogical)
-                                               , rightIdentity zeroi ]
+                                               , rightIdentityDynFlags zeroi ]
 
 -- Word operations
 primOpRules nm WordAddOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (+))
-                                               , identity zerow ]
+                                               , identityDynFlags zerow ]
 primOpRules nm WordSubOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (-))
-                                               , rightIdentity zerow
-                                               , equalArgs >> return (Lit zerow) ]
+                                               , rightIdentityDynFlags zerow
+                                               , equalArgs >> retLit zerow ]
 primOpRules nm WordMulOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (*))
-                                               , identity onew ]
+                                               , identityDynFlags onew ]
 primOpRules nm WordQuotOp  = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot)
-                                               , rightIdentity onew ]
+                                               , rightIdentityDynFlags onew ]
 primOpRules nm WordRemOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem)
-                                               , rightIdentity onew ]
+                                               , rightIdentityDynFlags onew ]
 primOpRules nm AndOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))
                                                , zeroElem zerow ]
 primOpRules nm OrOp        = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
-                                               , identity zerow ]
+                                               , identityDynFlags zerow ]
 primOpRules nm XorOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
-                                               , identity zerow
-                                               , equalArgs >> return (Lit zerow) ]
+                                               , identityDynFlags zerow
+                                               , equalArgs >> retLit zerow ]
 primOpRules nm SllOp       = mkPrimOpRule nm 2 [ binaryLit (wordShiftOp2 Bits.shiftL)
-                                               , rightIdentity zeroi ]
+                                               , rightIdentityDynFlags zeroi ]
 primOpRules nm SrlOp       = mkPrimOpRule nm 2 [ binaryLit (wordShiftOp2 shiftRightLogical)
-                                               , rightIdentity zeroi ]
+                                               , rightIdentityDynFlags zeroi ]
 
 -- coercions
-primOpRules nm Word2IntOp     = mkPrimOpRule nm 1 [ liftLit word2IntLit
+primOpRules nm Word2IntOp     = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit
                                                   , inversePrimOp Int2WordOp ]
-primOpRules nm Int2WordOp     = mkPrimOpRule nm 1 [ liftLit int2WordLit
+primOpRules nm Int2WordOp     = mkPrimOpRule nm 1 [ liftLitDynFlags int2WordLit
                                                   , inversePrimOp Word2IntOp ]
 primOpRules nm Narrow8IntOp   = mkPrimOpRule nm 1 [ liftLit narrow8IntLit ]
 primOpRules nm Narrow16IntOp  = mkPrimOpRule nm 1 [ liftLit narrow16IntLit ]
@@ -240,7 +241,7 @@ mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
 mkRelOpRule nm cmp extra
   = mkPrimOpRule nm 2 $ rules ++ extra
   where
-    rules = [ binaryLit (cmpOp cmp)
+    rules = [ binaryLit (\_ -> cmpOp cmp)
             , equalArgs >>
               -- x `cmp` x does not depend on x, so
               -- compute it for the arbitrary value 'True'
@@ -250,11 +251,13 @@ mkRelOpRule nm cmp extra
                         else falseVal) ]
 
 -- common constants
-zeroi, onei, zerow, onew, zerof, onef, zerod, oned :: Literal
-zeroi = mkMachInt 0
-onei  = mkMachInt 1
-zerow = mkMachWord 0
-onew  = mkMachWord 1
+zeroi, onei, zerow, onew :: DynFlags -> Literal
+zeroi dflags = mkMachInt  dflags 0
+onei  dflags = mkMachInt  dflags 1
+zerow dflags = mkMachWord dflags 0
+onew  dflags = mkMachWord dflags 1
+
+zerof, onef, zerod, oned :: Literal
 zerof = mkMachFloat 0.0
 onef  = mkMachFloat 1.0
 zerod = mkMachDouble 0.0
@@ -279,20 +282,20 @@ cmpOp cmp = go
 
 --------------------------
 
-negOp :: Literal -> Maybe CoreExpr  -- Negate
-negOp (MachFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational
-negOp (MachFloat f)    = Just (mkFloatVal (-f))
-negOp (MachDouble 0.0) = Nothing
-negOp (MachDouble d)   = Just (mkDoubleVal (-d))
-negOp (MachInt i)      = intResult (-i)
-negOp _                = Nothing
+negOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Negate
+negOp _      (MachFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational
+negOp _      (MachFloat f)    = Just (mkFloatVal (-f))
+negOp _      (MachDouble 0.0) = Nothing
+negOp _      (MachDouble d)   = Just (mkDoubleVal (-d))
+negOp dflags (MachInt i)      = intResult dflags (-i)
+negOp _      _                = Nothing
 
 --------------------------
 intOp2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
-       -> Literal -> Literal -> Maybe CoreExpr
-intOp2 op (MachInt i1) (MachInt i2) = intResult (fromInteger i1 `op` fromInteger i2)
-intOp2 _  _            _            = Nothing  -- Could find LitLit
+       -> DynFlags -> Literal -> Literal -> Maybe CoreExpr
+intOp2 op dflags (MachInt i1) (MachInt i2) = intResult dflags (fromInteger i1 `op` fromInteger i2)
+intOp2 _  _      _            _            = Nothing  -- Could find LitLit
 
 shiftRightLogical :: Integer -> Int -> Integer
 -- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do
@@ -302,32 +305,41 @@ shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word)
 
 
 --------------------------
+retLit :: (DynFlags -> Literal) -> RuleM CoreExpr
+retLit l = do dflags <- getDynFlags
+              return $ Lit $ l dflags
+
 wordOp2 :: (Integral a, Integral b)
         => (a -> b -> Integer)
-        -> Literal -> Literal -> Maybe CoreExpr
-wordOp2 op (MachWord w1) (MachWord w2) = wordResult (fromInteger w1 `op` fromInteger w2)
-wordOp2 _ _ _ = Nothing  -- Could find LitLit
-
-wordShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
+        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr
+wordOp2 op dflags (MachWord w1) (MachWord w2)
+    = wordResult dflags (fromInteger w1 `op` fromInteger w2)
+wordOp2 _ _ _ _ = Nothing  -- Could find LitLit
+
+wordShiftOp2 :: (Integer -> Int -> Integer)
+             -> DynFlags -> Literal -> Literal
+             -> Maybe CoreExpr
 -- Shifts take an Int; hence second arg of op is Int
-wordShiftOp2 op (MachWord x) (MachInt n)
-  = wordResult (x `op` fromInteger n)
+wordShiftOp2 op dflags (MachWord x) (MachInt n)
+  = wordResult dflags (x `op` fromInteger n)
     -- Do the shift at type Integer
-wordShiftOp2 _ _ _ = Nothing
+wordShiftOp2 _ _ _ _ = Nothing
 
 --------------------------
-floatOp2 :: (Rational -> Rational -> Rational) -> Literal -> Literal
+floatOp2 :: (Rational -> Rational -> Rational)
+         -> DynFlags -> Literal -> Literal
          -> Maybe (Expr CoreBndr)
-floatOp2  op (MachFloat f1) (MachFloat f2)
+floatOp2 op _ (MachFloat f1) (MachFloat f2)
   = Just (mkFloatVal (f1 `op` f2))
-floatOp2 _ _ _ = Nothing
+floatOp2 _ _ _ _ = Nothing
 
 --------------------------
-doubleOp2 :: (Rational -> Rational -> Rational) -> Literal -> Literal
+doubleOp2 :: (Rational -> Rational -> Rational)
+          -> DynFlags -> Literal -> Literal
           -> Maybe (Expr CoreBndr)
-doubleOp2  op (MachDouble f1) (MachDouble f2)
+doubleOp2 op _ (MachDouble f1) (MachDouble f2)
   = Just (mkDoubleVal (f1 `op` f2))
-doubleOp2 _ _ _ = Nothing
+doubleOp2 _ _ _ _ = Nothing
 
 --------------------------
 -- This stuff turns
@@ -411,13 +423,13 @@ isMaxBound _              = False
 --    ((124076834 :: Word32) + (2147483647 :: Word32))
 -- would yield a warning. Instead we simply squash the value into the
 -- *target* Int/Word range.
-intResult :: Integer -> Maybe CoreExpr
-intResult result
-  = Just (mkIntVal (toInteger (fromInteger result :: TargetInt)))
+intResult :: DynFlags -> Integer -> Maybe CoreExpr
+intResult dflags result
+  = Just (mkIntVal dflags (toInteger (fromInteger result :: TargetInt)))
 
-wordResult :: Integer -> Maybe CoreExpr
-wordResult result
-  = Just (mkWordVal (toInteger (fromInteger result :: TargetWord)))
+wordResult :: DynFlags -> Integer -> Maybe CoreExpr
+wordResult dflags result
+  = Just (mkWordVal dflags (toInteger (fromInteger result :: TargetWord)))
 
 inversePrimOp :: PrimOp -> RuleM CoreExpr
 inversePrimOp primop = do
@@ -440,31 +452,38 @@ mkBasicRule op_name n_args rm
   = BuiltinRule { ru_name = occNameFS (nameOccName op_name),
                   ru_fn = op_name,
                   ru_nargs = n_args,
-                  ru_try = \_ _ -> runRuleM rm }
+                  ru_try = \dflags _ -> runRuleM rm dflags }
 
 newtype RuleM r = RuleM
-  { runRuleM :: IdUnfoldingFun -> [CoreExpr] -> Maybe r }
+  { runRuleM :: DynFlags -> IdUnfoldingFun -> [CoreExpr] -> Maybe r }
 
 instance Monad RuleM where
-  return x = RuleM $ \_ _ -> Just x
-  RuleM f >>= g = RuleM $ \iu e -> case f iu e of
+  return x = RuleM $ \_ _ _ -> Just x
+  RuleM f >>= g = RuleM $ \dflags iu e -> case f dflags iu e of
     Nothing -> Nothing
-    Just r -> runRuleM (g r) iu e
+    Just r -> runRuleM (g r) dflags iu e
   fail _ = mzero
 
 instance MonadPlus RuleM where
-  mzero = RuleM $ \_ _ -> Nothing
-  mplus (RuleM f1) (RuleM f2) = RuleM $ \iu args ->
-    f1 iu args `mplus` f2 iu args
+  mzero = RuleM $ \_ _ _ -> Nothing
+  mplus (RuleM f1) (RuleM f2) = RuleM $ \dflags iu args ->
+    f1 dflags iu args `mplus` f2 dflags iu args
+
+instance HasDynFlags RuleM where
+    getDynFlags = RuleM $ \dflags _ _ -> Just dflags
 
 liftMaybe :: Maybe a -> RuleM a
 liftMaybe Nothing = mzero
 liftMaybe (Just x) = return x
 
 liftLit :: (Literal -> Literal) -> RuleM CoreExpr
-liftLit f = do
+liftLit f = liftLitDynFlags (const f)
+
+liftLitDynFlags :: (DynFlags -> Literal -> Literal) -> RuleM CoreExpr
+liftLitDynFlags f = do
+  dflags <- getDynFlags
   [Lit lit] <- getArgs
-  return $ Lit (f lit)
+  return $ Lit (f dflags lit)
 
 removeOp32 :: RuleM CoreExpr
 #if WORD_SIZE_IN_BITS == 32
@@ -476,56 +495,71 @@ removeOp32 = mzero
 #endif
 
 getArgs :: RuleM [CoreExpr]
-getArgs = RuleM $ \_ args -> Just args
+getArgs = RuleM $ \_ _ args -> Just args
 
 getIdUnfoldingFun :: RuleM IdUnfoldingFun
-getIdUnfoldingFun = RuleM $ \iu _ -> Just iu
+getIdUnfoldingFun = RuleM $ \_ iu _ -> Just iu
 
 -- return the n-th argument of this rule, if it is a literal
 -- argument indices start from 0
 getLiteral :: Int -> RuleM Literal
-getLiteral n = RuleM $ \_ exprs -> case drop n exprs of
+getLiteral n = RuleM $ \_ _ exprs -> case drop n exprs of
   (Lit l:_) -> Just l
   _ -> Nothing
 
-unaryLit :: (Literal -> Maybe CoreExpr) -> RuleM CoreExpr
+unaryLit :: (DynFlags -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
 unaryLit op = do
+  dflags <- getDynFlags
   [Lit l] <- getArgs
-  liftMaybe $ op (convFloating l)
+  liftMaybe $ op dflags (convFloating l)
 
-binaryLit :: (Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
+binaryLit :: (DynFlags -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
 binaryLit op = do
+  dflags <- getDynFlags
   [Lit l1, Lit l2] <- getArgs
-  liftMaybe $ convFloating l1 `op` convFloating l2
+  liftMaybe $ op dflags (convFloating l1) (convFloating l2)
 
 leftIdentity :: Literal -> RuleM CoreExpr
-leftIdentity id_lit = do
+leftIdentity id_lit = leftIdentityDynFlags (const id_lit)
+
+rightIdentity :: Literal -> RuleM CoreExpr
+rightIdentity id_lit = rightIdentityDynFlags (const id_lit)
+
+identity :: Literal -> RuleM CoreExpr
+identity lit = leftIdentity lit `mplus` rightIdentity lit
+
+leftIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr
+leftIdentityDynFlags id_lit = do
+  dflags <- getDynFlags
   [Lit l1, e2] <- getArgs
-  guard $ l1 == id_lit
+  guard $ l1 == id_lit dflags
   return e2
 
-rightIdentity :: Literal -> RuleM CoreExpr
-rightIdentity id_lit = do
+rightIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr
+rightIdentityDynFlags id_lit = do
+  dflags <- getDynFlags
   [e1, Lit l2] <- getArgs
-  guard $ l2 == id_lit
+  guard $ l2 == id_lit dflags
   return e1
 
-identity :: Literal -> RuleM CoreExpr
-identity lit = leftIdentity lit `mplus` rightIdentity lit
+identityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr
+identityDynFlags lit = leftIdentityDynFlags lit `mplus` rightIdentityDynFlags lit
 
-leftZero :: Literal -> RuleM CoreExpr
+leftZero :: (DynFlags -> Literal) -> RuleM CoreExpr
 leftZero zero = do
+  dflags <- getDynFlags
   [Lit l1, _] <- getArgs
-  guard $ l1 == zero
-  return $ Lit zero
+  guard $ l1 == zero dflags
+  return $ Lit l1
 
-rightZero :: Literal -> RuleM CoreExpr
+rightZero :: (DynFlags -> Literal) -> RuleM CoreExpr
 rightZero zero = do
+  dflags <- getDynFlags
   [_, Lit l2] <- getArgs
-  guard $ l2 == zero
-  return $ Lit zero
+  guard $ l2 == zero dflags
+  return $ Lit l2
 
-zeroElem :: Literal -> RuleM CoreExpr
+zeroElem :: (DynFlags -> Literal) -> RuleM CoreExpr
 zeroElem lit = leftZero lit `mplus` rightZero lit
 
 equalArgs :: RuleM ()
@@ -571,10 +605,10 @@ ltVal = Var ltDataConId
 eqVal = Var eqDataConId
 gtVal = Var gtDataConId
 
-mkIntVal :: Integer -> Expr CoreBndr
-mkIntVal    i = Lit (mkMachInt  i)
-mkWordVal :: Integer -> Expr CoreBndr
-mkWordVal   w = Lit (mkMachWord w)
+mkIntVal :: DynFlags -> Integer -> Expr CoreBndr
+mkIntVal dflags i = Lit (mkMachInt dflags i)
+mkWordVal :: DynFlags -> Integer -> Expr CoreBndr
+mkWordVal dflags w = Lit (mkMachWord dflags w)
 mkFloatVal :: Rational -> Expr CoreBndr
 mkFloatVal  f = Lit (convFloating (MachFloat  f))
 mkDoubleVal :: Rational -> Expr CoreBndr
@@ -649,11 +683,12 @@ dataToTagRule = a `mplus` b
       guard $ ty1 `eqType` ty2
       return tag -- dataToTag (tagToEnum x)   ==>   x
     b = do
+      dflags <- getDynFlags
       [_, val_arg] <- getArgs
       id_unf <- getIdUnfoldingFun
       (dc,_,_) <- liftMaybe $ exprIsConApp_maybe id_unf val_arg
       ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return ()
-      return $ mkIntVal (toInteger (dataConTag dc - fIRST_TAG))
+      return $ mkIntVal dflags (toInteger (dataConTag dc - fIRST_TAG))
 \end{code}
 
 %************************************************************************
@@ -732,8 +767,8 @@ builtinIntegerRules =
   rule_Word64ToInteger "word64ToInteger"    word64ToIntegerName,
   rule_convert        "integerToWord"       integerToWordName       mkWordLitWord,
   rule_convert        "integerToInt"        integerToIntName        mkIntLitInt,
-  rule_convert        "integerToWord64"     integerToWord64Name     mkWord64LitWord64,
-  rule_convert        "integerToInt64"      integerToInt64Name      mkInt64LitInt64,
+  rule_convert        "integerToWord64"     integerToWord64Name     (\_ -> mkWord64LitWord64),
+  rule_convert        "integerToInt64"      integerToInt64Name      (\_ -> mkInt64LitInt64),
   rule_binop          "plusInteger"         plusIntegerName         (+),
   rule_binop          "minusInteger"        minusIntegerName        (-),
   rule_binop          "timesInteger"        timesIntegerName        (*),
@@ -752,10 +787,10 @@ builtinIntegerRules =
   rule_divop_one      "quotInteger"         quotIntegerName         quot,
   rule_divop_one      "remInteger"          remIntegerName          rem,
   rule_encodeFloat    "encodeFloatInteger"  encodeFloatIntegerName  mkFloatLitFloat,
-  rule_convert        "floatFromInteger"    floatFromIntegerName    mkFloatLitFloat,
+  rule_convert        "floatFromInteger"    floatFromIntegerName    (\_ -> mkFloatLitFloat),
   rule_encodeFloat    "encodeDoubleInteger" encodeDoubleIntegerName mkDoubleLitDouble,
   rule_decodeDouble   "decodeDoubleInteger" decodeDoubleIntegerName,
-  rule_convert        "doubleFromInteger"   doubleFromIntegerName   mkDoubleLitDouble,
+  rule_convert        "doubleFromInteger"   doubleFromIntegerName   (\_ -> mkDoubleLitDouble),
   rule_binop          "gcdInteger"          gcdIntegerName          gcd,
   rule_binop          "lcmInteger"          lcmIntegerName          lcm,
   rule_binop          "andInteger"          andIntegerName          (.&.),
@@ -948,15 +983,15 @@ match_Word64ToInteger _ _ _ _ = Nothing
 
 -------------------------------------------------
 match_Integer_convert :: Num a
-                      => (a -> Expr CoreBndr)
+                      => (DynFlags -> a -> Expr CoreBndr)
                       -> DynFlags
                       -> Id
                       -> IdUnfoldingFun
                       -> [Expr CoreBndr]
                       -> Maybe (Expr CoreBndr)
-match_Integer_convert convert _ _ id_unf [xl]
+match_Integer_convert convert dflags _ id_unf [xl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
-  = Just (convert (fromInteger x))
+  = Just (convert dflags (fromInteger x))
 match_Integer_convert _ _ _ _ _ = Nothing
 
 match_Integer_unop :: (Integer -> Integer)
diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index ab3df0dfd0..681c183132 100644
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -33,6 +33,7 @@ import Type		( isUnLiftedType )
 import VarSet
 import Util
 import UniqFM
+import DynFlags
 import Outputable
 \end{code}
 
@@ -40,13 +41,13 @@ Top-level interface function, @floatInwards@.  Note that we do not
 actually float any bindings downwards from the top-level.
 
 \begin{code}
-floatInwards :: CoreProgram -> CoreProgram
-floatInwards = map fi_top_bind
+floatInwards :: DynFlags -> CoreProgram -> CoreProgram
+floatInwards dflags = map fi_top_bind
   where
     fi_top_bind (NonRec binder rhs)
-      = NonRec binder (fiExpr [] (freeVars rhs))
+      = NonRec binder (fiExpr dflags [] (freeVars rhs))
     fi_top_bind (Rec pairs)
-      = Rec [ (b, fiExpr [] (freeVars rhs)) | (b, rhs) <- pairs ]
+      = Rec [ (b, fiExpr dflags [] (freeVars rhs)) | (b, rhs) <- pairs ]
 \end{code}
 
 %************************************************************************
@@ -131,20 +132,21 @@ data FloatInBind = FB BoundVarSet FreeVarSet FloatBind
 type FloatInBinds = [FloatInBind]
 	-- In reverse dependency order (innermost binder first)
 
-fiExpr :: FloatInBinds		-- Binds we're trying to drop
-				-- as far "inwards" as possible
-       -> CoreExprWithFVs	-- Input expr
-       -> CoreExpr		-- Result
-
-fiExpr to_drop (_, AnnLit lit)     = ASSERT( null to_drop ) Lit lit
-fiExpr to_drop (_, AnnType ty)     = ASSERT( null to_drop ) Type ty
-fiExpr to_drop (_, AnnVar v)       = wrapFloats to_drop (Var v)
-fiExpr to_drop (_, AnnCoercion co) = wrapFloats to_drop (Coercion co)
-fiExpr to_drop (_, AnnCast expr (fvs_co, co))
+fiExpr :: DynFlags
+       -> FloatInBinds      -- Binds we're trying to drop
+                            -- as far "inwards" as possible
+       -> CoreExprWithFVs   -- Input expr
+       -> CoreExpr          -- Result
+
+fiExpr _ to_drop (_, AnnLit lit)     = ASSERT( null to_drop ) Lit lit
+fiExpr _ to_drop (_, AnnType ty)     = ASSERT( null to_drop ) Type ty
+fiExpr _ to_drop (_, AnnVar v)       = wrapFloats to_drop (Var v)
+fiExpr _ to_drop (_, AnnCoercion co) = wrapFloats to_drop (Coercion co)
+fiExpr dflags to_drop (_, AnnCast expr (fvs_co, co))
   = wrapFloats (drop_here ++ co_drop) $
-    Cast (fiExpr e_drop expr) co
+    Cast (fiExpr dflags e_drop expr) co
   where
-    [drop_here, e_drop, co_drop] = sepBindsByDropPoint False [freeVarsOf expr, fvs_co] to_drop
+    [drop_here, e_drop, co_drop] = sepBindsByDropPoint dflags False [freeVarsOf expr, fvs_co] to_drop
 \end{code}
 
 Applications: we do float inside applications, mainly because we
@@ -152,16 +154,16 @@ need to get at all the arguments.  The next simplifier run will
 pull out any silly ones.
 
 \begin{code}
-fiExpr to_drop (_,AnnApp fun arg@(arg_fvs, ann_arg))
+fiExpr dflags to_drop (_,AnnApp fun arg@(arg_fvs, ann_arg))
   | noFloatIntoRhs ann_arg  = wrapFloats drop_here $ wrapFloats arg_drop $
-                              App (fiExpr fun_drop fun) (fiExpr [] arg)
+                              App (fiExpr dflags fun_drop fun) (fiExpr dflags [] arg)
        -- It's inconvenient to test for an unlifted arg here,
        -- and it really doesn't matter if we float into one
   | otherwise               = wrapFloats drop_here $
-                              App (fiExpr fun_drop fun) (fiExpr arg_drop arg)
+                              App (fiExpr dflags fun_drop fun) (fiExpr dflags arg_drop arg)
   where
     [drop_here, fun_drop, arg_drop] 
-      = sepBindsByDropPoint False [freeVarsOf fun, arg_fvs] to_drop
+      = sepBindsByDropPoint dflags False [freeVarsOf fun, arg_fvs] to_drop
 \end{code}
 
 Note [Floating in past a lambda group]
@@ -203,13 +205,13 @@ Urk! if all are tyvars, and we don't float in, we may miss an
       opportunity to float inside a nested case branch
 
 \begin{code}
-fiExpr to_drop lam@(_, AnnLam _ _)
+fiExpr dflags to_drop lam@(_, AnnLam _ _)
   | okToFloatInside bndrs 	-- Float in
      -- NB: Must line up with noFloatIntoRhs (AnnLam...); see Trac #7088
-  = mkLams bndrs (fiExpr to_drop body)
+  = mkLams bndrs (fiExpr dflags to_drop body)
 
   | otherwise	 	-- Dump it all here
-  = wrapFloats to_drop (mkLams bndrs (fiExpr [] body))
+  = wrapFloats to_drop (mkLams bndrs (fiExpr dflags [] body))
 
   where
     (bndrs, body) = collectAnnBndrs lam
@@ -221,13 +223,13 @@ We don't float lets inwards past an SCC.
 	cc, change current cc to the new one and float binds into expr.
 
 \begin{code}
-fiExpr to_drop (_, AnnTick tickish expr)
+fiExpr dflags to_drop (_, AnnTick tickish expr)
   | tickishScoped tickish
   =     -- Wimp out for now - we could push values in
-    wrapFloats to_drop (Tick tickish (fiExpr [] expr))
+    wrapFloats to_drop (Tick tickish (fiExpr dflags [] expr))
 
   | otherwise
-  = Tick tickish (fiExpr to_drop expr)
+  = Tick tickish (fiExpr dflags to_drop expr)
 \end{code}
 
 For @Lets@, the possible ``drop points'' for the \tr{to_drop}
@@ -281,8 +283,8 @@ idFreeVars.
 
 
 \begin{code}
-fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
-  = fiExpr new_to_drop body
+fiExpr dflags to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
+  = fiExpr dflags new_to_drop body
   where
     body_fvs = freeVarsOf body `delVarSet` id
 
@@ -295,7 +297,7 @@ fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
 	-- Ditto ok-for-speculation unlifted RHSs
 
     [shared_binds, extra_binds, rhs_binds, body_binds] 
-	= sepBindsByDropPoint False [extra_fvs, rhs_fvs, body_fvs] to_drop
+	= sepBindsByDropPoint dflags False [extra_fvs, rhs_fvs, body_fvs] to_drop
 
     new_to_drop = body_binds ++				-- the bindings used only in the body
 		  [FB (unitVarSet id) rhs_fvs'
@@ -304,12 +306,12 @@ fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
 		  shared_binds  			-- the bindings used both in rhs and body
 
 	-- Push rhs_binds into the right hand side of the binding
-    rhs'     = fiExpr rhs_binds rhs
+    rhs'     = fiExpr dflags rhs_binds rhs
     rhs_fvs' = rhs_fvs `unionVarSet` floatedBindsFVs rhs_binds `unionVarSet` rule_fvs
 			-- Don't forget the rule_fvs; the binding mentions them!
 
-fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
-  = fiExpr new_to_drop body
+fiExpr dflags to_drop (_,AnnLet (AnnRec bindings) body)
+  = fiExpr dflags new_to_drop body
   where
     (ids, rhss) = unzip bindings
     rhss_fvs = map freeVarsOf rhss
@@ -322,7 +324,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
 			     , noFloatIntoRhs rhs ]
 
     (shared_binds:extra_binds:body_binds:rhss_binds) 
-	= sepBindsByDropPoint False (extra_fvs:body_fvs:rhss_fvs) to_drop
+	= sepBindsByDropPoint dflags False (extra_fvs:body_fvs:rhss_fvs) to_drop
 
     new_to_drop = body_binds ++		-- the bindings used only in the body
 		  [FB (mkVarSet ids) rhs_fvs' 
@@ -341,7 +343,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
 	    -> [(Id, CoreExpr)]
 
     fi_bind to_drops pairs
-      = [ (binder, fiExpr to_drop rhs) 
+      = [ (binder, fiExpr dflags to_drop rhs) 
 	| ((binder, rhs), to_drop) <- zipEqual "fi_bind" pairs to_drops ]
 \end{code}
 
@@ -358,32 +360,32 @@ alternative that binds the elements of the tuple. We now therefore also support
 floating in cases with a single alternative that may bind values.
 
 \begin{code}
-fiExpr to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])
+fiExpr dflags to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])
   | isUnLiftedType (idType case_bndr)
   , exprOkForSideEffects (deAnnotate scrut)
   = wrapFloats shared_binds $
-    fiExpr (case_float : rhs_binds) rhs
+    fiExpr dflags (case_float : rhs_binds) rhs
   where
     case_float = FB (mkVarSet (case_bndr : alt_bndrs)) scrut_fvs 
                     (FloatCase scrut' case_bndr con alt_bndrs)
-    scrut' = fiExpr scrut_binds scrut
+    scrut' = fiExpr dflags scrut_binds scrut
     [shared_binds, scrut_binds, rhs_binds]
-       = sepBindsByDropPoint False [freeVarsOf scrut, rhs_fvs] to_drop
+       = sepBindsByDropPoint dflags False [freeVarsOf scrut, rhs_fvs] to_drop
     rhs_fvs   = freeVarsOf rhs `delVarSetList` (case_bndr : alt_bndrs)
     scrut_fvs = freeVarsOf scrut
 
-fiExpr to_drop (_, AnnCase scrut case_bndr ty alts)
+fiExpr dflags to_drop (_, AnnCase scrut case_bndr ty alts)
   = wrapFloats drop_here1 $
     wrapFloats drop_here2 $
-    Case (fiExpr scrut_drops scrut) case_bndr ty
+    Case (fiExpr dflags scrut_drops scrut) case_bndr ty
 	 (zipWith fi_alt alts_drops_s alts)
   where
 	-- Float into the scrut and alts-considered-together just like App
     [drop_here1, scrut_drops, alts_drops] 
-       = sepBindsByDropPoint False [scrut_fvs, all_alts_fvs] to_drop
+       = sepBindsByDropPoint dflags False [scrut_fvs, all_alts_fvs] to_drop
 
 	-- Float into the alts with the is_case flag set
-    (drop_here2 : alts_drops_s) = sepBindsByDropPoint True alts_fvs alts_drops
+    (drop_here2 : alts_drops_s) = sepBindsByDropPoint dflags True alts_fvs alts_drops
 
     scrut_fvs    = freeVarsOf scrut
     alts_fvs     = map alt_fvs alts
@@ -392,7 +394,7 @@ fiExpr to_drop (_, AnnCase scrut case_bndr ty alts)
 				-- Delete case_bndr and args from free vars of rhs 
 				-- to get free vars of alt
 
-    fi_alt to_drop (con, args, rhs) = (con, args, fiExpr to_drop rhs)
+    fi_alt to_drop (con, args, rhs) = (con, args, fiExpr dflags to_drop rhs)
 
 okToFloatInside :: [Var] -> Bool
 okToFloatInside bndrs = all ok bndrs
@@ -444,7 +446,8 @@ We have to maintain the order on these drop-point-related lists.
 
 \begin{code}
 sepBindsByDropPoint
-    :: Bool		    -- True <=> is case expression
+    :: DynFlags
+    -> Bool             -- True <=> is case expression
     -> [FreeVarSet]	    -- One set of FVs per drop point
     -> FloatInBinds 	    -- Candidate floaters
     -> [FloatInBinds]      -- FIRST one is bindings which must not be floated
@@ -459,10 +462,10 @@ sepBindsByDropPoint
 
 type DropBox = (FreeVarSet, FloatInBinds)
 
-sepBindsByDropPoint _is_case drop_pts []
+sepBindsByDropPoint _ _is_case drop_pts []
   = [] : [[] | _ <- drop_pts]	-- cut to the chase scene; it happens
 
-sepBindsByDropPoint is_case drop_pts floaters
+sepBindsByDropPoint dflags is_case drop_pts floaters
   = go floaters (map (\fvs -> (fvs, [])) (emptyVarSet : drop_pts))
   where
     go :: FloatInBinds -> [DropBox] -> [FloatInBinds]
@@ -498,7 +501,7 @@ sepBindsByDropPoint is_case drop_pts floaters
 		   || (is_case && 		-- We are looking at case alternatives
 		       n_used_alts > 1 && 	-- It's used in more than one
 		       n_used_alts < n_alts &&	-- ...but not all
-		       floatIsDupable bind)	-- and we can duplicate the binding
+		       floatIsDupable dflags bind) -- and we can duplicate the binding
 
 	  new_boxes | drop_here = (insert here_box : fork_boxes)
 		    | otherwise = (here_box : new_fork_boxes)
@@ -525,8 +528,8 @@ wrapFloats :: FloatInBinds -> CoreExpr -> CoreExpr
 wrapFloats []               e = e
 wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e)
 
-floatIsDupable :: FloatBind -> Bool
-floatIsDupable (FloatCase scrut _ _ _) = exprIsDupable scrut
-floatIsDupable (FloatLet (Rec prs))    = all (exprIsDupable . snd) prs
-floatIsDupable (FloatLet (NonRec _ r)) = exprIsDupable r
+floatIsDupable :: DynFlags -> FloatBind -> Bool
+floatIsDupable dflags (FloatCase scrut _ _ _) = exprIsDupable dflags scrut
+floatIsDupable dflags (FloatLet (Rec prs))    = all (exprIsDupable dflags . snd) prs
+floatIsDupable dflags (FloatLet (NonRec _ r)) = exprIsDupable dflags r
 \end{code}
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 731f55128c..268a918e37 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -378,8 +378,8 @@ doCorePass _      CoreCSE                   = {-# SCC "CommonSubExpr" #-}
 doCorePass _      CoreLiberateCase          = {-# SCC "LiberateCase" #-}
                                               doPassD liberateCase
 
-doCorePass _      CoreDoFloatInwards        = {-# SCC "FloatInwards" #-}
-                                              doPass floatInwards
+doCorePass dflags CoreDoFloatInwards        = {-# SCC "FloatInwards" #-}
+                                              doPass (floatInwards dflags)
 
 doCorePass _      (CoreDoFloatOutwards f)   = {-# SCC "FloatOutwards" #-}
                                               doPassDUM (floatOutwards f)
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 68c82f5718..f76fec1033 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -2338,11 +2338,12 @@ mkDupableAlts env case_bndr' the_alts
 
 mkDupableAlt :: SimplEnv -> OutId -> (AltCon, [CoreBndr], CoreExpr)
               -> SimplM (SimplEnv, (AltCon, [CoreBndr], CoreExpr))
-mkDupableAlt env case_bndr (con, bndrs', rhs')
-  | exprIsDupable rhs'  -- Note [Small alternative rhs]
-  = return (env, (con, bndrs', rhs'))
-  | otherwise
-  = do  { let rhs_ty'  = exprType rhs'
+mkDupableAlt env case_bndr (con, bndrs', rhs') = do
+  dflags <- getDynFlags
+  if exprIsDupable dflags rhs'  -- Note [Small alternative rhs]
+   then return (env, (con, bndrs', rhs'))
+   else
+    do  { let rhs_ty'  = exprType rhs'
               scrut_ty = idType case_bndr
               case_bndr_w_unf
                 = case con of
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index bbad59ec6e..2de781578d 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -251,15 +251,24 @@ cases (the rest are caught in lookupInst).
 
 \begin{code}
 newOverloadedLit :: CtOrigin
-		 -> HsOverLit Name
-		 -> TcRhoType
-		 -> TcM (HsOverLit TcId)
-newOverloadedLit orig 
+                 -> HsOverLit Name
+                 -> TcRhoType
+                 -> TcM (HsOverLit TcId)
+newOverloadedLit orig lit res_ty
+    = do dflags <- getDynFlags
+         newOverloadedLit' dflags orig lit res_ty
+
+newOverloadedLit' :: DynFlags
+                  -> CtOrigin
+                  -> HsOverLit Name
+                  -> TcRhoType
+                  -> TcM (HsOverLit TcId)
+newOverloadedLit' dflags orig
   lit@(OverLit { ol_val = val, ol_rebindable = rebindable
 	       , ol_witness = meth_name }) res_ty
 
   | not rebindable
-  , Just expr <- shortCutLit val res_ty 
+  , Just expr <- shortCutLit dflags val res_ty 
 	-- Do not generate a LitInst for rebindable syntax.  
 	-- Reason: If we do, tcSimplify will call lookupInst, which
 	--	   will call tcSyntaxName, which does unification, 
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 1ddcd316c1..84907fb306 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -126,24 +126,24 @@ hsLitType (HsDoublePrim _) = doublePrimTy
 Overloaded literals. Here mainly becuase it uses isIntTy etc
 
 \begin{code}
-shortCutLit :: OverLitVal -> TcType -> Maybe (HsExpr TcId)
-shortCutLit (HsIntegral i) ty
-  | isIntTy ty && inIntRange i   = Just (HsLit (HsInt i))
-  | isWordTy ty && inWordRange i = Just (mkLit wordDataCon (HsWordPrim i))
-  | isIntegerTy ty 	       	 = Just (HsLit (HsInteger i ty))
-  | otherwise		       	 = shortCutLit (HsFractional (integralFractionalLit i)) ty
+shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr TcId)
+shortCutLit dflags (HsIntegral i) ty
+  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt i))
+  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim i))
+  | isIntegerTy ty = Just (HsLit (HsInteger i ty))
+  | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit i)) ty
 	-- The 'otherwise' case is important
 	-- Consider (3 :: Float).  Syntactically it looks like an IntLit,
 	-- so we'll call shortCutIntLit, but of course it's a float
 	-- This can make a big difference for programs with a lot of
 	-- literals, compiled without -O
 
-shortCutLit (HsFractional f) ty
+shortCutLit _ (HsFractional f) ty
   | isFloatTy ty  = Just (mkLit floatDataCon  (HsFloatPrim f))
   | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
   | otherwise     = Nothing
 
-shortCutLit (HsIsString s) ty
+shortCutLit _ (HsIsString s) ty
   | isStringTy ty = Just (HsLit (HsString s))
   | otherwise     = Nothing
 
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index 8c5ef0045d..527cbfcb4d 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -728,11 +728,12 @@ vectLam inline loop_breaker expr@(fvs, AnnLam _ _)  vi
     -- in Figure 6 of HtM.
     break_loop lc ty (ve, le)
       | loop_breaker
-      = do { empty <- emptyPD ty
+      = do { dflags <- getDynFlags
+           ; empty <- emptyPD ty
            ; lty   <- mkPDataType ty
            ; return (ve, mkWildCase (Var lc) intPrimTy lty
                            [(DEFAULT, [], le),
-                            (LitAlt (mkMachInt 0), [], empty)])
+                            (LitAlt (mkMachInt dflags 0), [], empty)])
            }
       | otherwise = return (ve, le)
 vectLam _ _ _ _ = panic "vectLam"
@@ -844,9 +845,10 @@ vectAlgCase tycon _ty_args scrut bndr ty alts (VITNode _ (scrutVit : altVits))
 
     proc_alt arity sel _ lty ((DataAlt dc, bndrs, body),  vi)
       = do
+          dflags <- getDynFlags
           vect_dc <- maybeV dataConErr (lookupDataCon dc)
           let ntag = dataConTagZ vect_dc
-              tag  = mkDataConTag vect_dc
+              tag  = mkDataConTag dflags vect_dc
               fvs  = freeVarsOf body `delVarSetList` bndrs
 
           sel_tags  <- liftM (`App` sel) (builtin (selTags arity))
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 0051d072a4..5dfbaa5555 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -36,6 +36,7 @@ import OccName
 
 import Util
 import Outputable
+import DynFlags
 import FastString
 import MonadUtils
 
@@ -375,8 +376,9 @@ vectDataConWorkers orig_tc vect_tc arr_tc
     rep_tys  = map dataConRepArgTys $ tyConDataCons vect_tc
 
     mk_data_con con tys pre post
-      = liftM2 (,) (vect_data_con con)
-                   (lift_data_con tys pre post (mkDataConTag con))
+      = do dflags <- getDynFlags
+           liftM2 (,) (vect_data_con con)
+                      (lift_data_con tys pre post (mkDataConTag dflags con))
 
     sel_replicate len tag
       | arity > 1 = do
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index 9ed4e2c60e..a03875f116 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -37,6 +37,7 @@ import Type
 import TyCon
 import DataCon
 import MkId
+import DynFlags
 import FastString
 
 -- Simple Types ---------------------------------------------------------------
@@ -58,8 +59,8 @@ newLocalVVar fs vty
 
 -- Constructors ---------------------------------------------------------------
 
-mkDataConTag :: DataCon -> CoreExpr
-mkDataConTag = mkIntLitInt . dataConTagZ
+mkDataConTag :: DynFlags -> DataCon -> CoreExpr
+mkDataConTag dflags = mkIntLitInt dflags . dataConTagZ
 
 dataConTagZ :: DataCon -> Int
 dataConTagZ con = dataConTag con - fIRST_TAG
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs
index 4ad7deef19..bf0e99e58e 100644
--- a/includes/HaskellConstants.hs
+++ b/includes/HaskellConstants.hs
@@ -48,11 +48,6 @@ type TargetWord = Word64
 #error unknown SIZEOF_HSWORD
 #endif
 
-tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
-tARGET_MIN_INT  = fromIntegral (minBound :: TargetInt)
-tARGET_MAX_INT  = fromIntegral (maxBound :: TargetInt)
-tARGET_MAX_WORD = fromIntegral (maxBound :: TargetWord)
-
 tARGET_MAX_CHAR :: Int
 tARGET_MAX_CHAR = 0x10ffff