Commit fe83ac4d authored by Yannik Potdevin's avatar Yannik Potdevin
Browse files

Fixed ticket 1324 (do not expand constructor pattern to failed expression).

parent d02680b0
......@@ -183,33 +183,35 @@ completeConsAlts r ea ce alts = do
complPats <- mapM genPat $ getComplConstrs mdl menv
[ c | (Alt (ConstructorPattern c _) _) <- consAlts ]
[v, w] <- newIdentList 2 "x"
let e' = getDefaultAlt v
return $ case complPats of
[] -> Case r ea ce consAlts
ps -> bindDefVar v ce w e' ps
let me = lookupDefaultAlt v
return $ let c = Case r ea ce consAlts
in case (complPats, me) of
([] , _) -> c
(_:_, Nothing) -> c
(ps , Just e') -> bindDefVar v ce w e' ps
where
-- existing contructor pattern alternatives
consAlts = filter isConstrAlt alts
-- generate a new constructor pattern
genPat (qid, arity) = ConstructorPattern qid <$> newIdentList arity "x"
-- default alternative
getDefaultAlt v = case find isVarAlt alts of
Just (Alt (VariablePattern x) de) -> replaceVar x (Variable v) de
_ -> failedExpr
-- create a binding for @v = e@ if needed
bindDefVar v e w e' ps
| v `elem` fv e' = mkBinding v e $ mkCase (Variable v) w e' ps
| otherwise = mkCase e w e' ps
-- create a binding for @w = e'@ if needed, and a case expression
-- @case e of { consAlts ++ (ps -> w) }@
mkCase e w e' ps = case ps of
[p] -> Case r ea e (consAlts ++ [Alt p e'])
_ -> mkBinding w e'
$ Case r ea e (consAlts ++ [Alt p (Variable w) | p <- ps])
-- existing contructor pattern alternatives
consAlts = filter isConstrAlt alts
-- generate a new constructor pattern
genPat (qid, arity) = ConstructorPattern qid <$> newIdentList arity "x"
-- default alternative, if there is one
lookupDefaultAlt v =
fmap (\(Alt (VariablePattern x) de) -> replaceVar x (Variable v) de)
$ find isVarAlt alts
-- create a binding for @v = e@ if needed
bindDefVar v e w e' ps
| v `elem` fv e' = mkBinding v e $ mkCase (Variable v) w e' ps
| otherwise = mkCase e w e' ps
-- create a binding for @w = e'@ if needed, and a case expression
-- @case e of { consAlts ++ (ps -> w) }@
mkCase e w e' ps = case ps of
[p] -> Case r ea e (consAlts ++ [Alt p e'])
_ -> mkBinding w e'
$ Case r ea e (consAlts ++ [Alt p (Variable w) | p <- ps])
-- If the alternatives' branches contain literal patterns, a complementary
-- constructor list cannot be generated because it would become potentially
......
-- This module belongs to the ticket 1324
module MissingCaseCompletion where
-- The missing constructor False should not be expanded to "False -> Failed".
-- Instead it should be omitted.
f :: Bool -> Int
f b = case b of
True -> 1
-- The catch all pattern should be expanded to "False -> 0".
g :: Bool -> Int
g b = case b of
True -> 1
_ -> 0
-- The catch all pattern should be expanded to "False -> failed"
h :: Bool -> Int
h b = case b of
True -> 1
_ -> failed
-- To summarize the issue: If a case expression explicitely ignores at least one
-- constructor (i.e. it does not enumerate everyone and does not use a default
-- pattern), do not fill up with missing constructors and failed expressions.
\ No newline at end of file
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