Commit 83978093 authored by Finn Teegen's avatar Finn Teegen

Merge branch 'pretty-unreachability-warnings' into 'master'

Emit correct locations for warnings about unreachable case branches

Closes #84

See merge request !22
parents 7ce2d620 aba41bb3
......@@ -455,10 +455,10 @@ checkExpr (Let _ _ ds e) = inNestedScope $ do
reportUnusedVars
checkExpr (Do _ _ sts e) = checkStatements sts e
checkExpr (IfThenElse _ e1 e2 e3) = mapM_ checkExpr [e1, e2, e3]
checkExpr (Case _ _ ct e alts) = do
checkExpr (Case spi _ ct e alts) = do
checkExpr e
mapM_ checkAlt alts
checkCaseAlts ct alts
checkCaseAlts spi ct alts
checkExpr _ = ok
checkStatements :: [Statement ()] -> Expression () -> WCM ()
......@@ -584,9 +584,10 @@ warnAliasNameClash mids = posMessage (head mids) $ text
-- Check for overlapping/unreachable and non-exhaustive case alternatives
-- -----------------------------------------------------------------------------
checkCaseAlts :: CaseType -> [Alt ()] -> WCM ()
checkCaseAlts _ [] = ok
checkCaseAlts ct alts@(Alt spi _ _ : _) = do
checkCaseAlts :: SpanInfo -> CaseType -> [Alt ()] -> WCM ()
checkCaseAlts _ _ [] = ok
checkCaseAlts spi ct alts = do
let spis = map (\(Alt s _ _) -> s) alts
let pats = map (\(Alt _ pat _) -> [pat]) alts
let guards = map alt2Guards alts
(nonExhaustive, overlapped, nondet) <- checkPatternMatching pats guards
......@@ -600,7 +601,7 @@ checkCaseAlts ct alts@(Alt spi _ _ : _) = do
unless (null nonExhaustive) $ warnFor WarnIncompletePatterns $ report $
warnMissingPattern p "a case alternative" nonExhaustive
unless (null overlapped) $ warnFor WarnOverlapping $ report $
warnUnreachablePattern p overlapped
warnUnreachablePattern (spanInfo2Pos $ (spis !!) $ fst $ head overlapped) $ map snd overlapped
where p = spanInfo2Pos spi
alt2Guards :: Alt () -> [CondExpr ()]
alt2Guards (Alt _ _ (GuardedRhs _ _ conds _)) = conds
......@@ -623,17 +624,17 @@ checkCaseAlts ct alts@(Alt spi _ _ : _) = do
-- -----------------------------------------------------------------------------
checkPatternMatching :: [[Pattern ()]] -> [[CondExpr ()]]
-> WCM ([ExhaustivePats], [[Pattern ()]], Bool)
-> WCM ([ExhaustivePats], [OverlappingPats], Bool)
checkPatternMatching pats guards = do
-- 1. We simplify the patterns by removing syntactic sugar temporarily
-- for a simpler implementation.
simplePats <- mapM (mapM simplifyPat) pats
-- 2. We compute missing and used pattern matching alternatives
(missing, used, nondet) <- processEqs (zip3 [1..] simplePats guards)
(missing, used, nondet) <- processEqs (zip3 [0..] simplePats guards)
-- 3. If any, we report the missing patterns, whereby we re-add the syntactic
-- sugar removed in step (1) for a more precise output.
nonExhaustive <- mapM tidyExhaustivePats missing
let overlap = [eqn | (i, eqn) <- zip [1..] pats, i `IntSet.notMember` used]
let overlap = [(i, eqn) | (i, eqn) <- zip [0..] pats, i `IntSet.notMember` used]
return (nonExhaustive, overlap, nondet)
-- |Simplify a 'Pattern' until it only consists of
......@@ -702,6 +703,7 @@ type EqnNo = Int
type EqnInfo = (EqnNo, EqnPats, EqnGuards)
type ExhaustivePats = (EqnPats, [(Ident, [Literal])])
type OverlappingPats = (EqnNo, EqnPats)
type EqnSet = IntSet.IntSet
-- |Compute the missing pattern by inspecting the first patterns and
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment