diff options
| author | simonpj@microsoft.com <unknown> | 2010-11-16 17:18:43 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-11-16 17:18:43 +0000 |
| commit | 67157c5c25c8044b54419470b5e8cc677be060c3 (patch) | |
| tree | 385a9dc751149254d5beb712d855bc140f46a51d /compiler/hsSyn | |
| parent | b9c34f4729c68fbe278cd69050d7a429c75b29b2 (diff) | |
| download | haskell-67157c5c25c8044b54419470b5e8cc677be060c3.tar.gz | |
Warn a bit less often about unlifted bindings.
Warn when
(a) a pattern bindings binds unlifted values
(b) it has no top-level bang
(c) the RHS has a *lifted* type
Clause (c) is new, argued for by Simon M
Eg x# = 4# + 4# -- No warning
(# a,b #) = blah -- No warning
I# x = blah -- Warning
Diffstat (limited to 'compiler/hsSyn')
| -rw-r--r-- | compiler/hsSyn/HsPat.lhs | 24 |
1 files changed, 22 insertions, 2 deletions
diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index fe3003d909..78b5887a59 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -22,7 +22,8 @@ module HsPat ( mkPrefixConPat, mkCharLitPat, mkNilPat, - isBangHsBind, isBangLPat, hsPatNeedsParens, + isBangHsBind, isLiftedPatBind, + isBangLPat, hsPatNeedsParens, isIrrefutableHsPat, pprParendLPat @@ -374,10 +375,29 @@ isBangLPat (L _ (ParPat p)) = isBangLPat p isBangLPat _ = False isBangHsBind :: HsBind id -> Bool --- In this module because HsPat is above HsBinds in the import graph +-- A pattern binding with an outermost bang +-- Defined in this module because HsPat is above HsBinds in the import graph isBangHsBind (PatBind { pat_lhs = p }) = isBangLPat p isBangHsBind _ = False +isLiftedPatBind :: HsBind id -> Bool +-- A pattern binding with a compound pattern, not just a variable +-- (I# x) yes +-- (# a, b #) no, even if a::Int# +-- x no, even if x::Int# +-- We want to warn about a missing bang-pattern on the yes's +isLiftedPatBind (PatBind { pat_lhs = p }) = isLiftedLPat p +isLiftedPatBind _ = False + +isLiftedLPat :: LPat id -> Bool +isLiftedLPat (L _ (ParPat p)) = isLiftedLPat p +isLiftedLPat (L _ (BangPat p)) = isLiftedLPat p +isLiftedLPat (L _ (AsPat _ p)) = isLiftedLPat p +isLiftedLPat (L _ (TuplePat _ Unboxed _)) = False +isLiftedLPat (L _ (VarPat {})) = False +isLiftedLPat (L _ (WildPat {})) = False +isLiftedLPat _ = True + isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, -- in the sense of falling through to the next pattern. |