[commit: ghc] master: Fix debug-only check in CoreLint (c5b1014)
git at git.haskell.org
git at git.haskell.org
Thu Apr 28 16:32:39 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/c5b1014eb0a477aa32691841dcc2739dbcd2bc85/ghc
>---------------------------------------------------------------
commit c5b1014eb0a477aa32691841dcc2739dbcd2bc85
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Thu Apr 28 17:27:02 2016 +0100
Fix debug-only check in CoreLint
>---------------------------------------------------------------
c5b1014eb0a477aa32691841dcc2739dbcd2bc85
compiler/coreSyn/CoreLint.hs | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index aaed959..26383af 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -657,7 +657,8 @@ lintCoreExpr (Lam var expr)
lintCoreExpr e@(Case scrut var alt_ty alts) =
-- Check the scrutinee
- do { scrut_ty <- lintCoreExpr scrut
+ do { let scrut_diverges = exprIsBottom scrut
+ ; scrut_ty <- lintCoreExpr scrut
; (alt_ty, _) <- lintInTy alt_ty
; (var_ty, _) <- lintInTy (idType var)
@@ -665,7 +666,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
; when (null alts) $
do { checkL (not (exprIsHNF scrut))
(text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut)
- ; checkL (exprIsBottom scrut)
+ ; checkL scrut_diverges
(text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut)
}
@@ -680,11 +681,12 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
; case tyConAppTyCon_maybe (idType var) of
Just tycon
- | debugIsOn &&
- isAlgTyCon tycon &&
- not (isFamilyTyCon tycon || isAbstractTyCon tycon) &&
- null (tyConDataCons tycon) ->
- pprTrace "Lint warning: case binder's type has no constructors" (ppr var <+> ppr (idType var))
+ | debugIsOn
+ , isAlgTyCon tycon
+ , not (isAbstractTyCon tycon)
+ , null (tyConDataCons tycon)
+ , not scrut_diverges
+ -> pprTrace "Lint warning: case binder's type has no constructors" (ppr var <+> ppr (idType var))
-- This can legitimately happen for type families
$ return ()
_otherwise -> return ()
More information about the ghc-commits
mailing list