diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/Types/Literal.hs | 42 |
2 files changed, 42 insertions, 19 deletions
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index 4913bbd3ce..934fd6d726 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -454,12 +454,19 @@ emitCmmLitSwitch scrut branches deflt = do rep = typeWidth cmm_ty -- We find the necessary type information in the literals in the branches - let signed = case head branches of - (LitNumber nt _, _) -> litNumIsSigned nt - _ -> False - - let range | signed = (platformMinInt platform, platformMaxInt platform) - | otherwise = (0, platformMaxWord platform) + let (signed,range) = case head branches of + (LitNumber nt _, _) -> (signed,range) + where + signed = litNumIsSigned nt + range = case litNumRange platform nt of + (Just mi, Just ma) -> (mi,ma) + -- unbounded literals (Natural and + -- Integer) must have been + -- lowered at this point + partial_bounds -> pprPanic "Unexpected unbounded literal range" + (ppr partial_bounds) + -- assuming native word range + _ -> (False, (0, platformMaxWord platform)) if isFloatType cmm_ty then emit =<< mk_float_switch rep scrut' deflt_lbl noBound branches_lbls diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 9d3f8f0a29..968e26c03b 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -38,6 +38,7 @@ module GHC.Types.Literal , literalType , pprLiteral , litNumIsSigned + , litNumRange , litNumCheckRange , litNumWrap , litNumCoerce @@ -369,19 +370,31 @@ litNumNarrow _ _ l = pprPanic "litNumNarrow: invalid literal" (ppr l) -- | Check that a given number is in the range of a numeric literal litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool -litNumCheckRange platform nt i = case nt of - LitNumInt -> platformInIntRange platform i - LitNumWord -> platformInWordRange platform i - LitNumInt8 -> inBoundedRange @Int8 i - LitNumInt16 -> inBoundedRange @Int16 i - LitNumInt32 -> inBoundedRange @Int32 i - LitNumInt64 -> inBoundedRange @Int64 i - LitNumWord8 -> inBoundedRange @Word8 i - LitNumWord16 -> inBoundedRange @Word16 i - LitNumWord32 -> inBoundedRange @Word32 i - LitNumWord64 -> inBoundedRange @Word64 i - LitNumNatural -> i >= 0 - LitNumInteger -> True +litNumCheckRange platform nt i = + maybe True (i >=) m_lower && + maybe True (i <=) m_upper + where + (m_lower, m_upper) = litNumRange platform nt + +-- | Get the literal range +litNumRange :: Platform -> LitNumType -> (Maybe Integer, Maybe Integer) +litNumRange platform nt = case nt of + LitNumInt -> (Just (platformMinInt platform), Just (platformMaxInt platform)) + LitNumWord -> (Just 0, Just (platformMaxWord platform)) + LitNumInt8 -> bounded_range @Int8 + LitNumInt16 -> bounded_range @Int16 + LitNumInt32 -> bounded_range @Int32 + LitNumInt64 -> bounded_range @Int64 + LitNumWord8 -> bounded_range @Word8 + LitNumWord16 -> bounded_range @Word16 + LitNumWord32 -> bounded_range @Word32 + LitNumWord64 -> bounded_range @Word64 + LitNumNatural -> (Just 0, Nothing) + LitNumInteger -> (Nothing, Nothing) + where + bounded_range :: forall a . (Integral a, Bounded a) => (Maybe Integer,Maybe Integer) + bounded_range = case boundedRange @a of + (mi,ma) -> (Just mi, Just ma) -- | Create a numeric 'Literal' of the given type mkLitNumber :: Platform -> LitNumType -> Integer -> Literal @@ -577,6 +590,9 @@ inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool inBoundedRange x = x >= toInteger (minBound :: a) && x <= toInteger (maxBound :: a) +boundedRange :: forall a. (Bounded a, Integral a) => (Integer,Integer) +boundedRange = (toInteger (minBound :: a), toInteger (maxBound :: a)) + isMinBound :: Platform -> Literal -> Bool isMinBound _ (LitChar c) = c == minBound isMinBound platform (LitNumber nt i) = case nt of |