X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FMatch.lhs;h=5437929a7bb0870d27d4e3e2e6a9da0c68b9cb10;hb=68afb16743cafd5b7495771d359891c6dfc5a186;hp=fd4bb5dfcef84b1d76f589a3da5435202610b554;hpb=a77abe6a30ea2763cfa1c0ca83cdce9b7200ced2;p=ghc-hetmet.git diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs index fd4bb5d..5437929 100644 --- a/ghc/compiler/deSugar/Match.lhs +++ b/ghc/compiler/deSugar/Match.lhs @@ -12,7 +12,7 @@ import Ubiq import DsLoop -- here for paranoia-checking reasons -- and to break dsExpr/dsBinds-ish loop -import HsSyn +import HsSyn hiding ( collectBinders{-also from CoreSyn-} ) import TcHsSyn ( TypecheckedPat(..), TypecheckedMatch(..), TypecheckedHsBinds(..), TypecheckedHsExpr(..) ) import DsHsSyn ( outPatType, collectTypedPatBinders ) @@ -334,7 +334,7 @@ tidy1 v (RecPat con_id pat_ty rpats) match_result pats = map mk_pat tagged_arg_tys -- Boring stuff to find the arg-tys of the constructor - (_, inst_tys, _) = _trace "getAppDataTyCon.Match" $ getAppDataTyCon pat_ty + (_, inst_tys, _) = {-_trace "getAppDataTyCon.Match" $-} getAppDataTyCon pat_ty con_arg_tys' = dataConArgTys con_id inst_tys tagged_arg_tys = con_arg_tys' `zip` allFieldLabelTags @@ -513,21 +513,24 @@ matchUnmixedEqns :: [Id] matchUnmixedEqns [] _ _ = panic "matchUnmixedEqns: no names" matchUnmixedEqns all_vars@(var:vars) eqns_info shadows - | unfailablePats column_1_pats -- Could check just one; we know they've been tidied, unmixed; - -- this way is (arguably) a sanity-check - = -- Real true variables, just like in matchVar, SLPJ p 94 + | unfailablePat first_pat + = ASSERT( unfailablePats column_1_pats ) -- Sanity check + -- Real true variables, just like in matchVar, SLPJ p 94 match vars remaining_eqns_info remaining_shadows - | patsAreAllCons column_1_pats -- ToDo: maybe check just one... - = matchConFamily all_vars eqns_info shadows + | isConPat first_pat + = ASSERT( patsAreAllCons column_1_pats ) + matchConFamily all_vars eqns_info shadows - | patsAreAllLits column_1_pats -- ToDo: maybe check just one... - = -- see notes in MatchLiteral + | isLitPat first_pat + = ASSERT( patsAreAllLits column_1_pats ) + -- see notes in MatchLiteral -- not worried about the same literal more than once in a column -- (ToDo: sort this out later) matchLiterals all_vars eqns_info shadows where + first_pat = head column_1_pats column_1_pats = [pat | EqnInfo (pat:_) _ <- eqns_info] remaining_eqns_info = [EqnInfo pats match_result | EqnInfo (_:pats) match_result <- eqns_info] remaining_shadows = [EqnInfo pats match_result | EqnInfo (pat:pats) match_result <- shadows,