Ensure that Literals are in range
[ghc.git] / compiler / deSugar / MatchLit.hs
index 9849eec..2e9a523 100644 (file)
@@ -8,7 +8,7 @@ Pattern-matching literal patterns
 
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
 
-module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey
+module MatchLit ( dsLit, dsOverLit, hsLitKey
                 , tidyLitPat, tidyNPat
                 , matchLiterals, matchNPlusKPats, matchNPats
                 , warnAboutIdentities, warnAboutEmptyEnumerations
@@ -375,36 +375,25 @@ matchLiterals [] _ _ = panic "matchLiterals []"
 
 ---------------------------
 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)
+-- Get the Core literal corresponding to a HsLit.
 -- It only works for primitive types and strings;
 -- others have been removed by tidy
-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    (fastStringToByteString s)
+-- For HsString, it produces a MachStr, which really represents an _unboxed_
+-- string literal; and we deal with it in matchLiterals above. Otherwise, it
+-- produces a primitive Literal of type matching the original HsLit.
+-- In the case of the fixed-width numeric types, we need to wrap here
+-- because Literal has an invariant that the literal is in range, while
+-- HsLit does not.
+hsLitKey dflags (HsIntPrim    _ i) = mkMachIntWrap  dflags i
+hsLitKey dflags (HsWordPrim   _ w) = mkMachWordWrap dflags w
+hsLitKey _      (HsInt64Prim  _ i) = mkMachInt64Wrap       i
+hsLitKey _      (HsWord64Prim _ w) = mkMachWord64Wrap      w
+hsLitKey _      (HsCharPrim   _ c) = mkMachChar            c
+hsLitKey _      (HsFloatPrim    f) = mkMachFloat           (fl_value f)
+hsLitKey _      (HsDoublePrim   d) = mkMachDouble          (fl_value d)
+hsLitKey _      (HsString _ s)     = MachStr (fastStringToByteString s)
 hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
----------------------------
-hsOverLitKey :: HsOverLit a -> Bool -> Literal
--- Ditto for HsOverLit; the boolean indicates to negate
-hsOverLitKey (OverLit { ol_val = l }) neg = litValKey l neg
-
----------------------------
-litValKey :: OverLitVal -> Bool -> Literal
-litValKey (HsIntegral _ i) False = MachInt i
-litValKey (HsIntegral _ i) True  = MachInt (-i)
-litValKey (HsFractional r) False = MachFloat (fl_value r)
-litValKey (HsFractional r) True  = MachFloat (negate (fl_value r))
-litValKey (HsIsString _ s) neg   = ASSERT( not neg) MachStr
-                                                      (fastStringToByteString s)
-
 {-
 ************************************************************************
 *                                                                      *