From 0a55a3cada2fea37586b1a270c1511ed9957dbd4 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 5 Jun 2014 11:03:45 +0100 Subject: Fix egregious instantiation bug in matchOneConLike (fixing Trac #9023) We simply weren't giving anything like the right instantiating types to patSynInstArgTys in matchOneConLike. To get these instantiating types would have involved matching the result type of the pattern synonym with the pattern type, which is tiresome. So instead I changed ConPatOut so that instead of recording the type of the *whole* pattern (in old field pat_ty), it not records the *instantiating* types (in new field pat_arg_tys). Then we canuse TcHsSyn.conLikeResTy to get the pattern type when needed. There are lots of knock-on incidental effects, but they mostly made the code simpler, so I'm happy. --- compiler/deSugar/MatchLit.lhs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'compiler/deSugar/MatchLit.lhs') diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 07cf420372..350ed22d69 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -266,8 +266,8 @@ tidyLitPat :: HsLit -> Pat Id tidyLitPat (HsChar c) = unLoc (mkCharLitPat c) tidyLitPat (HsString s) | lengthFS s <= 1 -- Short string literals only - = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy) - (mkNilPat stringTy) (unpackFS s) + = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy]) + (mkNilPat charTy) (unpackFS s) -- The stringTy is the type of the whole pattern, not -- the type to instantiate (:) or [] with! tidyLitPat lit = LitPat lit @@ -299,7 +299,7 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _ | 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) + mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] []) mb_int_lit :: Maybe Integer mb_int_lit = case (mb_neg, val) of -- cgit v1.2.1