diff options
| author | Ian Lynagh <igloo@earth.li> | 2009-04-24 17:33:13 +0000 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2009-04-24 17:33:13 +0000 |
| commit | 40b8f4c53505de002e92a33fc85f780fd83cbb9a (patch) | |
| tree | 48049145368e76770c82d5e51dfe09d68a907512 /compiler | |
| parent | 269210b04b1428ae5270f15024ab9af23c7497fc (diff) | |
| download | haskell-40b8f4c53505de002e92a33fc85f780fd83cbb9a.tar.gz | |
Fix a lint failure when we have a ! (# ... #) pattern in a where clause
This showed up when converting ds057 to follow the new bang pattern rules,
in #2806.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/deSugar/Match.lhs | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index 24c4680f7d..474f7bf63f 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -519,6 +519,21 @@ tidy1 _ (LitPat lit) tidy1 _ (NPat lit mb_neg eq) = return (idDsWrapper, tidyNPat lit mb_neg eq) +-- BangPatterns: Pattern matching is already strict in constructors, +-- tuples etc, so the last case strips off the bang for thoses patterns. +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) +tidy1 _ p@(BangPat (L _ (SigPatOut _ _))) = return (idDsWrapper, p) +tidy1 v (BangPat (L _ (AsPat (L _ var) pat))) + = do { (wrap, pat') <- tidy1 v (BangPat pat) + ; return (wrapBind var v . wrap, pat') } +tidy1 v (BangPat (L _ p)) = tidy1 v p + -- Everything else goes through unchanged... tidy1 _ non_interesting_pat |