diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Hs/Type.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Types.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 6 |
4 files changed, 16 insertions, 13 deletions
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 212de3930b..4eabc2fec9 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -202,7 +202,7 @@ type instance XHsWC GhcTc b = [Name] type instance XXHsWildCardBndrs (GhcPass _) _ = NoExtCon -type instance XHsPS GhcPs = NoExtField +type instance XHsPS GhcPs = EpAnn EpaLocation type instance XHsPS GhcRn = HsPSRn type instance XHsPS GhcTc = HsPSRn @@ -251,9 +251,9 @@ mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing mkHsWildCardBndrs x = HsWC { hswc_body = x , hswc_ext = noExtField } -mkHsPatSigType :: LHsType GhcPs -> HsPatSigType GhcPs -mkHsPatSigType x = HsPS { hsps_ext = noExtField - , hsps_body = x } +mkHsPatSigType :: EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs +mkHsPatSigType ann x = HsPS { hsps_ext = ann + , hsps_body = x } mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing mkEmptyWildCardBndrs x = HsWC { hswc_body = x diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 9ca63e5b50..5319063b0f 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -873,7 +873,7 @@ mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs] mkRuleBndrs = fmap (fmap cvt_one) where cvt_one (RuleTyTmVar ann v Nothing) = RuleBndr ann v cvt_one (RuleTyTmVar ann v (Just sig)) = - RuleBndrSig ann v (mkHsPatSigType sig) + RuleBndrSig ann v (mkHsPatSigType noAnn sig) -- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs] @@ -1094,7 +1094,7 @@ checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args | not (null args) && patIsRec c = add_hint SuggestRecursiveDo $ patFail (locA l) (ppr e) -checkPat loc (L _ (PatBuilderAppType f _ t)) tyargs args = +checkPat loc (L _ (PatBuilderAppType f t)) tyargs args = checkPat loc f (t : tyargs) args checkPat loc (L _ (PatBuilderApp f e)) [] args = do p <- checkLPat e @@ -1740,7 +1740,10 @@ instance DisambECP (PatBuilder GhcPs) where type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs superFunArg m = m mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2) - mkHsAppTypePV l p la t = return $ L l (PatBuilderAppType p la (mkHsPatSigType t)) + mkHsAppTypePV l p la t = do + cs <- getCommentsFor (locA l) + let anns = EpAnn (spanAsAnchor (combineSrcSpans la (getLocA t))) (EpaSpan (realSrcSpan la)) cs + return $ L l (PatBuilderAppType p (mkHsPatSigType anns t)) mkHsIfPV l _ _ _ _ _ _ = addFatalError $ PsError PsErrIfTheElseInPat [] l mkHsDoPV l _ _ _ = addFatalError $ PsError PsErrDoNotationInPat [] l mkHsParPV l p an = return $ L (noAnnSrcSpan l) (PatBuilderPar p an) @@ -1753,7 +1756,7 @@ instance DisambECP (PatBuilder GhcPs) where mkHsTySigPV l b sig anns = do p <- checkLPat b cs <- getCommentsFor (locA l) - return $ L l (PatBuilderPat (SigPat (EpAnn (spanAsAnchor $ locA l) anns cs) p (mkHsPatSigType sig))) + return $ L l (PatBuilderPat (SigPat (EpAnn (spanAsAnchor $ locA l) anns cs) p (mkHsPatSigType noAnn sig))) mkHsExplicitListPV l xs anns = do ps <- traverse checkLPat xs cs <- getCommentsFor l diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs index 5369367ed2..b42d04f881 100644 --- a/compiler/GHC/Parser/Types.hs +++ b/compiler/GHC/Parser/Types.hs @@ -54,7 +54,7 @@ data PatBuilder p = PatBuilderPat (Pat p) | PatBuilderPar (LocatedA (PatBuilder p)) AnnParen | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p)) - | PatBuilderAppType (LocatedA (PatBuilder p)) SrcSpan (HsPatSigType GhcPs) + | PatBuilderAppType (LocatedA (PatBuilder p)) (HsPatSigType GhcPs) | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName) (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn]) | PatBuilderVar (LocatedN RdrName) @@ -64,7 +64,7 @@ instance Outputable (PatBuilder GhcPs) where ppr (PatBuilderPat p) = ppr p ppr (PatBuilderPar (L _ p) _) = parens (ppr p) ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2 - ppr (PatBuilderAppType (L _ p) _ t) = ppr p <+> text "@" <> ppr t + ppr (PatBuilderAppType (L _ p) t) = ppr p <+> text "@" <> ppr t ppr (PatBuilderOpApp (L _ p1) op (L _ p2) _) = ppr p1 <+> ppr op <+> ppr p2 ppr (PatBuilderVar v) = ppr v ppr (PatBuilderOverLit l) = ppr l diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index b4e9fb7c08..967a669f6c 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -875,7 +875,7 @@ cvtRuleBndr (RuleVar n) cvtRuleBndr (TypedRuleVar n ty) = do { n' <- vNameN n ; ty' <- cvtType ty - ; return $ noLoc $ Hs.RuleBndrSig noAnn n' $ mkHsPatSigType ty' } + ; return $ noLoc $ Hs.RuleBndrSig noAnn n' $ mkHsPatSigType noAnn ty' } --------------------------------------------------- -- Declarations @@ -1319,7 +1319,7 @@ cvtp (ConP s ts ps) = do { s' <- cNameN s ; return $ ConPat { pat_con_ext = noAnn , pat_con = s' - , pat_args = PrefixCon (map mkHsPatSigType ts') pps + , pat_args = PrefixCon (map (mkHsPatSigType noAnn) ts') pps } } cvtp (InfixP p1 s p2) = do { s' <- cNameN s; p1' <- cvtPat p1; p2' <- cvtPat p2 @@ -1354,7 +1354,7 @@ cvtp (ListP ps) = do { ps' <- cvtPats ps ; return $ ListPat noAnn ps'} cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t - ; return $ SigPat noAnn p' (mkHsPatSigType t') } + ; return $ SigPat noAnn p' (mkHsPatSigType noAnn t') } cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p ; return $ ViewPat noAnn e' p'} |