X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatch.lhs;h=9d7e12424340d5422d70db949f17f2d3b8aa7239;hb=faca1a62c1385aa6ebdeb7d25ffa193ba2283fb9;hp=aa2e9fe1105e48e839d61fa7743be02620e43252;hpb=310c00498677181c35c632678711a5c82f151674;p=ghc-hetmet.git diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index aa2e9fe..9d7e124 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -280,13 +280,13 @@ match vars@(v:_) ty eqns = ASSERT( not (null eqns ) ) do { -- Tidy the first pattern, generating -- auxiliary bindings if necessary - (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns + (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn - ; let grouped = groupEquations tidy_eqns + ; let grouped = groupEquations tidy_eqns -- print the view patterns that are commoned up to help debug - ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped) ; match_results <- mapM match_group grouped ; return (adjustMatchResult (foldr1 (.) aux_binds) $ @@ -468,11 +468,6 @@ tidy1 _ (WildPat ty) = return (idDsWrapper, WildPat ty) tidy1 v (VarPat var) = return (wrapBind var v, WildPat (idType var)) -tidy1 v (VarPatOut var binds) - = do { ds_ev_binds <- dsTcEvBinds binds - ; return (wrapBind var v . wrapDsEvBinds ds_ev_binds, - WildPat (idType var)) } - -- case v of { x@p -> mr[] } -- = case v of { p -> let x=v in mr[] } tidy1 v (AsPat (L _ var) pat) @@ -530,7 +525,6 @@ tidy1 _ (NPat lit mb_neg eq) tidy1 v (BangPat (L _ (LazyPat p))) = tidy1 v (BangPat p) tidy1 v (BangPat (L _ (ParPat p))) = tidy1 v (BangPat p) tidy1 _ p@(BangPat (L _(VarPat _))) = return (idDsWrapper, p) -tidy1 _ p@(BangPat (L _(VarPatOut _ _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (WildPat _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (CoPat _ _ _))) = return (idDsWrapper, p) tidy1 _ p@(BangPat (L _ (SigPatIn _ _))) = return (idDsWrapper, p) @@ -886,7 +880,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 lexp e1 e1' && lexp e2 e2' exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) = eq_list tup_arg es1 es2 - exp (HsIf e e1 e2) (HsIf e' e1' e2') = + exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') = lexp e e' && lexp e1 e1' && lexp e2 e2' -- Enhancement: could implement equality for more expressions