X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchLit.lhs;h=2da52c78b03ffb977b40a20e549223c84484162b;hb=4da93ad236882128b7b446e83a2c159ef17d7ffa;hp=6d7db7cce87a8056d6452b7f5bd36447fd7d9893;hpb=ecdaf6bc29d23bd704df8c65442ee08032a585fc;p=ghc-hetmet.git diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 6d7db7c..2da52c7 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -22,6 +22,7 @@ import HsSyn import Id import CoreSyn +import MkCore import TyCon import DataCon import TcHsSyn ( shortCutLit ) @@ -61,12 +62,12 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc. \begin{code} dsLit :: HsLit -> DsM CoreExpr -dsLit (HsStringPrim s) = return (mkLit (MachStr s)) -dsLit (HsCharPrim c) = return (mkLit (MachChar c)) -dsLit (HsIntPrim i) = return (mkLit (MachInt i)) -dsLit (HsWordPrim w) = return (mkLit (MachWord w)) -dsLit (HsFloatPrim f) = return (mkLit (MachFloat f)) -dsLit (HsDoublePrim d) = return (mkLit (MachDouble d)) +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 (HsFloatPrim f) = return (Lit (MachFloat f)) +dsLit (HsDoublePrim d) = return (Lit (MachDouble d)) dsLit (HsChar c) = return (mkCharExpr c) dsLit (HsString str) = mkStringExprFS str @@ -154,7 +155,7 @@ tidyLitPat lit = LitPat lit ---------------- tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Pat Id -tidyNPat over_lit@(OverLit val False _ ty) mb_neg eq +tidyNPat (OverLit val False _ ty) mb_neg _ -- Take short cuts only if the literal is not using rebindable syntax | isIntTy ty = mk_con_pat intDataCon (HsIntPrim int_val) | isWordTy ty = mk_con_pat wordDataCon (HsWordPrim int_val) @@ -247,14 +248,8 @@ matchLiterals [] _ _ = panic "matchLiterals []" %************************************************************************ \begin{code} -matchNPats :: [Id] -> Type -> [[EquationInfo]] -> DsM MatchResult - -- All NPats, but perhaps for different literals -matchNPats vars ty groups - = do { match_results <- mapM (matchOneNPat vars ty) groups - ; return (foldr1 combineMatchResults match_results) } - -matchOneNPat :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult -matchOneNPat (var:vars) ty (eqn1:eqns) -- All for the same literal +matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult +matchNPats (var:vars) ty (eqn1:eqns) -- All for the same literal = do { let NPat lit mb_neg eq_chk = firstPat eqn1 ; lit_expr <- dsOverLit lit ; neg_lit <- case mb_neg of @@ -265,7 +260,7 @@ matchOneNPat (var:vars) ty (eqn1:eqns) -- All for the same literal ; let pred_expr = mkApps eq_expr [Var var, neg_lit] ; match_result <- match vars ty (shiftEqns (eqn1:eqns)) ; return (mkGuardedMatchResult pred_expr match_result) } -matchOneNPat vars _ eqns = pprPanic "matchOneNPat" (ppr (vars, eqns)) +matchNPats vars _ eqns = pprPanic "matchOneNPat" (ppr (vars, eqns)) \end{code}