X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchLit.lhs;h=50fec2fd12b88a2dcfb388a71feac469ad4c2867;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=d7e8ba64d8f565963c73ca8ddb911c5b03678f01;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index d7e8ba6..50fec2f 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -27,12 +27,10 @@ import TcType import Type import PrelNames import TysWiredIn -import PrelNames import Unique import Literal import SrcLoc import Ratio -import SrcLoc import Outputable import Util import FastString @@ -87,6 +85,7 @@ dsOverLit :: HsOverLit Id -> DsM CoreExpr -- (an expression for) the literal value itself dsOverLit (HsIntegral _ lit) = dsExpr lit dsOverLit (HsFractional _ lit) = dsExpr lit +dsOverLit (HsIsString _ lit) = dsExpr lit \end{code} \begin{code} @@ -109,6 +108,8 @@ hsOverLitKey (HsIntegral i _) False = MachInt i hsOverLitKey (HsIntegral i _) True = MachInt (-i) hsOverLitKey (HsFractional r _) False = MachFloat r hsOverLitKey (HsFractional r _) True = MachFloat (-r) +hsOverLitKey (HsIsString s _) False = MachStr s +-- negated string should never happen \end{code} %************************************************************************ @@ -140,6 +141,7 @@ tidyNPat over_lit mb_neg eq lit_ty | isIntTy lit_ty = mk_con_pat intDataCon (HsIntPrim int_val) | isFloatTy lit_ty = mk_con_pat floatDataCon (HsFloatPrim rat_val) | isDoubleTy lit_ty = mk_con_pat doubleDataCon (HsDoublePrim rat_val) +-- | isStringTy lit_ty = mk_con_pat stringDataCon (HsStringPrim str_val) | otherwise = NPat over_lit mb_neg eq lit_ty where mk_con_pat :: DataCon -> HsLit -> Pat Id @@ -158,6 +160,11 @@ tidyNPat over_lit mb_neg eq lit_ty rat_val = case neg_lit of HsIntegral i _ -> fromInteger i HsFractional f _ -> f + + str_val :: FastString + str_val = case neg_lit of + HsIsString s _ -> s + _ -> error "tidyNPat" \end{code} @@ -174,7 +181,8 @@ matchLiterals :: [Id] -> DsM MatchResult matchLiterals (var:vars) ty sub_groups - = do { -- Deal with each group + = ASSERT( all notNull sub_groups ) + do { -- Deal with each group ; alts <- mapM match_group sub_groups -- Combine results. For everything except String