X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatch.lhs;h=f545930a48c44826faf1a38aaf5de112a27d880d;hb=5244158455f546d07632e48c718a771a8f2145a3;hp=793cc56391cd32c81f3d46c4e002d41ffafbc83e;hpb=96a7900481db325e220667f794eb7499ea64fbc4;p=ghc-hetmet.git diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index 793cc56..f545930 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -43,6 +43,7 @@ import Maybes import Util import Name import Outputable +import FastString \end{code} This function is a wrapper of @match@, it must be called from all the parts where @@ -111,11 +112,11 @@ dsShadowWarn ctx@(DsMatchContext kind loc) qs = putSrcSpanDs loc (warnDs warn) where warn | qs `lengthExceeds` maximum_output - = pp_context ctx (ptext SLIT("are overlapped")) + = pp_context ctx (ptext (sLit "are overlapped")) (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$ - ptext SLIT("...")) + ptext (sLit "...")) | otherwise - = pp_context ctx (ptext SLIT("are overlapped")) + = pp_context ctx (ptext (sLit "are overlapped")) (\ f -> vcat $ map (ppr_eqn f kind) qs) @@ -123,19 +124,19 @@ dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM () dsIncompleteWarn ctx@(DsMatchContext kind loc) pats = putSrcSpanDs loc (warnDs warn) where - warn = pp_context ctx (ptext SLIT("are non-exhaustive")) - (\_ -> hang (ptext SLIT("Patterns not matched:")) + warn = pp_context ctx (ptext (sLit "are non-exhaustive")) + (\_ -> hang (ptext (sLit "Patterns not matched:")) 4 ((vcat $ map (ppr_incomplete_pats kind) (take maximum_output pats)) $$ dots)) - dots | pats `lengthExceeds` maximum_output = ptext SLIT("...") + dots | pats `lengthExceeds` maximum_output = ptext (sLit "...") | otherwise = empty pp_context :: DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun - = vcat [ptext SLIT("Pattern match(es)") <+> msg, - sep [ptext SLIT("In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]] + = vcat [ptext (sLit "Pattern match(es)") <+> msg, + sep [ptext (sLit "In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]] where (ppr_match, pref) = case kind of @@ -147,16 +148,16 @@ ppr_pats pats = sep (map ppr pats) ppr_shadow_pats :: HsMatchContext Name -> [Pat Id] -> SDoc ppr_shadow_pats kind pats - = sep [ppr_pats pats, matchSeparator kind, ptext SLIT("...")] + = sep [ppr_pats pats, matchSeparator kind, ptext (sLit "...")] ppr_incomplete_pats :: HsMatchContext Name -> ExhaustivePat -> SDoc ppr_incomplete_pats _ (pats,[]) = ppr_pats pats ppr_incomplete_pats _ (pats,constraints) = - sep [ppr_pats pats, ptext SLIT("with"), + sep [ppr_pats pats, ptext (sLit "with"), sep (map ppr_constraint constraints)] ppr_constraint :: (Name,[HsLit]) -> SDoc -ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats] +ppr_constraint (var,pats) = sep [ppr var, ptext (sLit "`notElem`"), ppr pats] ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> EquationInfo -> SDoc ppr_eqn prefixF kind eqn = prefixF (ppr_shadow_pats kind (eqn_pats eqn)) @@ -842,8 +843,8 @@ viewLExprEq (e1,_) (e2,_) = -- equating different ways of writing a coercion) wrap WpHole WpHole = True wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2' - wrap (WpCo c) (WpCo c') = tcEqType c c' - wrap (WpApp d) (WpApp d') = d == d' + wrap (WpCast c) (WpCast c') = tcEqType c c' + wrap (WpApp d) (WpApp d') = d == d' wrap (WpTyApp t) (WpTyApp t') = tcEqType t t' -- Enhancement: could implement equality for more wrappers -- if it seems useful (lams and lets)