Commit e79e580b authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix Trac #5117: desugar literal patterns consistencly

parent 24c0c8c2
......@@ -671,8 +671,6 @@ tidy_pat (CoPat _ pat _) = tidy_pat pat
tidy_pat (NPlusKPat id _ _ _) = WildPat (idType (unLoc id))
tidy_pat (ViewPat _ _ ty) = WildPat ty
tidy_pat (NPat lit mb_neg eq) = tidyNPat lit mb_neg eq
tidy_pat pat@(ConPatOut { pat_con = L _ id, pat_args = ps })
= pat { pat_args = tidy_con id ps }
......@@ -696,16 +694,18 @@ tidy_pat (TuplePat ps boxity ty)
where
arity = length ps
-- Unpack string patterns fully, so we can see when they overlap with
-- each other, or even explicit lists of Chars.
tidy_pat (LitPat lit)
tidy_pat (NPat lit mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq
tidy_pat (LitPat lit) = tidy_lit_pat lit
tidy_lit_pat :: HsLit -> Pat Id
-- Unpack string patterns fully, so we can see when they
-- overlap with each other, or even explicit lists of Chars.
tidy_lit_pat lit
| HsString s <- lit
= unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mk_char_lit c, pat] stringTy)
= unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy)
(mkPrefixConPat nilDataCon [] stringTy) (unpackFS s)
| otherwise
= tidyLitPat lit
where
mk_char_lit c = mkPrefixConPat charDataCon [nlLitPat (HsCharPrim c)] charTy
-----------------
tidy_con :: DataCon -> HsConPatDetails Id -> HsConPatDetails Id
......
......@@ -522,7 +522,7 @@ tidy1 _ (LitPat lit)
-- NPats: we *might* be able to replace these w/ a simpler form
tidy1 _ (NPat lit mb_neg eq)
= return (idDsWrapper, tidyNPat lit mb_neg eq)
= return (idDsWrapper, tidyNPat tidyLitPat 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.
......
......@@ -152,8 +152,14 @@ tidyLitPat (HsString s)
tidyLitPat lit = LitPat lit
----------------
tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Pat Id
tidyNPat (OverLit val False _ ty) mb_neg _
tidyNPat :: (HsLit -> Pat Id) -- How to tidy a LitPat
-- We need this argument because tidyNPat is called
-- both by Match and by Check, but they tidy LitPats
-- slightly differently; and we must desugar
-- literals consistently (see Trac #5117)
-> HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id
-> Pat Id
tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
-- False: Take short cuts only if the literal is not using rebindable syntax
--
-- Once that is settled, look for cases where the type of the
......@@ -169,7 +175,7 @@ tidyNPat (OverLit val False _ ty) mb_neg _
| isWordTy ty, Just int_lit <- mb_int_lit = mk_con_pat wordDataCon (HsWordPrim int_lit)
| isFloatTy ty, Just rat_lit <- mb_rat_lit = mk_con_pat floatDataCon (HsFloatPrim rat_lit)
| isDoubleTy ty, Just rat_lit <- mb_rat_lit = mk_con_pat doubleDataCon (HsDoublePrim rat_lit)
| isStringTy ty, Just str_lit <- mb_str_lit = tidyLitPat (HsString str_lit)
| isStringTy ty, Just str_lit <- mb_str_lit = tidy_lit_pat (HsString str_lit)
where
mk_con_pat :: DataCon -> HsLit -> Pat Id
mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] ty)
......@@ -193,7 +199,7 @@ tidyNPat (OverLit val False _ ty) mb_neg _
(Nothing, HsIsString s) -> Just s
_ -> Nothing
tidyNPat over_lit mb_neg eq
tidyNPat _ over_lit mb_neg eq
= NPat over_lit mb_neg eq
\end{code}
......
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