diff options
Diffstat (limited to 'compiler/deSugar/MatchLit.hs')
| -rw-r--r-- | compiler/deSugar/MatchLit.hs | 40 |
1 files changed, 21 insertions, 19 deletions
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs index 748de5c8de..c3ba420232 100644 --- a/compiler/deSugar/MatchLit.hs +++ b/compiler/deSugar/MatchLit.hs @@ -74,22 +74,22 @@ For numeric literals, we try to detect there use at a standard type See also below where we look for @DictApps@ for \tr{plusInt}, etc. -} -dsLit :: HsLit -> DsM CoreExpr +dsLit :: HsLit GhcRn -> DsM CoreExpr dsLit (HsStringPrim _ s) = return (Lit (MachStr s)) dsLit (HsCharPrim _ c) = return (Lit (MachChar c)) dsLit (HsIntPrim _ i) = return (Lit (MachInt i)) dsLit (HsWordPrim _ w) = return (Lit (MachWord w)) dsLit (HsInt64Prim _ i) = return (Lit (MachInt64 i)) dsLit (HsWord64Prim _ w) = return (Lit (MachWord64 w)) -dsLit (HsFloatPrim f) = return (Lit (MachFloat (fl_value f))) -dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d))) +dsLit (HsFloatPrim _ f) = return (Lit (MachFloat (fl_value f))) +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) = do dflags <- getDynFlags +dsLit (HsInt _ i) = do dflags <- getDynFlags return (mkIntExpr dflags (il_value i)) -dsLit (HsRat (FL _ _ val) ty) = do +dsLit (HsRat _ (FL _ _ val) ty) = do num <- mkIntegerExpr (numerator val) denom <- mkIntegerExpr (denominator val) return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom]) @@ -100,12 +100,12 @@ dsLit (HsRat (FL _ _ val) ty) = do (head (tyConDataCons tycon), i_ty) x -> pprPanic "dsLit" (ppr x) -dsOverLit :: HsOverLit Id -> DsM CoreExpr +dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr dsOverLit lit = do { dflags <- getDynFlags ; warnAboutOverflowedLiterals dflags lit ; dsOverLit' dflags lit } -dsOverLit' :: DynFlags -> HsOverLit Id -> DsM CoreExpr +dsOverLit' :: DynFlags -> HsOverLit GhcTc -> DsM CoreExpr -- Post-typechecker, the HsExpr field of an OverLit contains -- (an expression for) the literal value itself dsOverLit' dflags (OverLit { ol_val = val, ol_rebindable = rebindable @@ -153,7 +153,7 @@ conversionNames -- We can't easily add fromIntegerName, fromRationalName, -- because they are generated by literals -warnAboutOverflowedLiterals :: DynFlags -> HsOverLit Id -> DsM () +warnAboutOverflowedLiterals :: DynFlags -> HsOverLit GhcTc -> DsM () warnAboutOverflowedLiterals dflags lit | wopt Opt_WarnOverflowedLiterals dflags , Just (i, tc) <- getIntegralLit lit @@ -200,7 +200,8 @@ We get an erroneous suggestion for but perhaps that does not matter too much. -} -warnAboutEmptyEnumerations :: DynFlags -> LHsExpr Id -> Maybe (LHsExpr Id) -> LHsExpr Id -> DsM () +warnAboutEmptyEnumerations :: DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc) + -> LHsExpr GhcTc -> DsM () -- Warns about [2,3 .. 1] which returns the empty list -- Only works for integral types, not floating point warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr @@ -233,7 +234,7 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr | otherwise = return () -getLHsIntegralLit :: LHsExpr Id -> Maybe (Integer, Name) +getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name) -- See if the expression is an Integral literal -- Remember to look through automatically-added tick-boxes! (Trac #8384) getLHsIntegralLit (L _ (HsPar e)) = getLHsIntegralLit e @@ -242,7 +243,7 @@ getLHsIntegralLit (L _ (HsBinTick _ _ e)) = getLHsIntegralLit e getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit getLHsIntegralLit _ = Nothing -getIntegralLit :: HsOverLit Id -> Maybe (Integer, Name) +getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name) getIntegralLit (OverLit { ol_val = HsIntegral i, ol_type = ty }) | Just tc <- tyConAppTyCon_maybe ty = Just (il_value i, tyConName tc) @@ -256,7 +257,7 @@ getIntegralLit _ = Nothing ************************************************************************ -} -tidyLitPat :: HsLit -> Pat Id +tidyLitPat :: HsLit GhcTc -> Pat GhcTc -- Result has only the following HsLits: -- HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim -- HsDoublePrim, HsStringPrim, HsString @@ -273,13 +274,14 @@ tidyLitPat (HsString src s) tidyLitPat lit = LitPat lit ---------------- -tidyNPat :: (HsLit -> Pat Id) -- How to tidy a LitPat +tidyNPat :: (HsLit GhcTc -> Pat GhcTc) -- How to tidy a LitPat -- We need this argument because tidyNPat is called -- both by Match and by Check, but they tidy LitPats -- slightly differently; and we must desugar -- literals consistently (see Trac #5117) - -> HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Type - -> Pat Id + -> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc + -> Type + -> Pat GhcTc tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty -- False: Take short cuts only if the literal is not using rebindable syntax -- @@ -308,7 +310,7 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty -- type family Id). In these cases, we can't do the short-cut. type_change = not (outer_ty `eqType` ty) - mk_con_pat :: DataCon -> HsLit -> Pat Id + mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] []) mb_int_lit :: Maybe Integer @@ -375,7 +377,7 @@ matchLiterals (var:vars) ty sub_groups matchLiterals [] _ _ = panic "matchLiterals []" --------------------------- -hsLitKey :: DynFlags -> HsLit -> Literal +hsLitKey :: DynFlags -> HsLit GhcTc -> Literal -- Get the Core literal corresponding to a HsLit. -- It only works for primitive types and strings; -- others have been removed by tidy @@ -390,8 +392,8 @@ 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 _ (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) |