Merge remote-tracking branch 'origin/master'

2 files changed, 33 insertions, 32 deletions

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index 8fbcbb7a88..a590eae1b2 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,17 +344,16 @@ 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)
-                         = fromInteger i <= ord minBound
-                        && fromInteger i >= ord maxBound
-litFitsInChar _         = False
+litFitsInChar (MachInt i) = i >= toInteger (ord minBound)
+                         && i <= toInteger (ord maxBound)
+litFitsInChar _           = False
 
 litIsLifted :: Literal -> Bool
 litIsLifted (LitInteger {}) = True
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 7bb5d160b9..1805ccd25e 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -505,14 +505,14 @@ mkDictSelId no_unf name clas
 				-- varToCoreExpr needed for equality superclass selectors
 				--   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
 
-dictSelRule :: Int -> Arity 
-            -> Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
+dictSelRule :: Int -> Arity
+            -> DynFlags -> Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
 -- Tries to persuade the argument to look like a constructor
 -- application, using exprIsConApp_maybe, and then selects
 -- from it
 --       sel_i t1..tk (D t1..tk op1 ... opm) = opi
 --
-dictSelRule val_index n_ty_args _ id_unf args
+dictSelRule val_index n_ty_args _ _ id_unf args
   | (dict_arg : _) <- drop n_ty_args args
   , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
   = Just (con_args !! val_index)
@@ -935,12 +935,13 @@ seqId = pcMiscPrelId seqName ty info
                                 , ru_try   = match_seq_of_cast
                                 }
 
-match_seq_of_cast :: Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
+match_seq_of_cast :: DynFlags -> Id -> IdUnfoldingFun -> [CoreExpr]
+                  -> Maybe CoreExpr
     -- See Note [Built-in RULES for seq]
-match_seq_of_cast _ _ [Type _, Type res_ty, Cast scrut co, expr]
+match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co, expr]
   = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
                               scrut, expr])
-match_seq_of_cast _ _ _ = Nothing
+match_seq_of_cast _ _ _ _ = Nothing
 
 ------------------------------------------------
 lazyId :: Id	-- See Note [lazyId magic]