diff options
Diffstat (limited to 'compiler/GHC/Rename')
| -rw-r--r-- | compiler/GHC/Rename/Expr.hs | 10 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Module.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Pat.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Utils.hs | 2 |
4 files changed, 16 insertions, 14 deletions
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index 70233c0854..8503dc400c 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -283,7 +283,7 @@ rnExpr (HsUnboundVar _ v) rnExpr (HsOverLabel _ v) = do { (from_label, fvs) <- lookupSyntaxName fromLabelClassOpName ; return ( mkExpandedExpr (HsOverLabel noAnn v) $ - HsAppType noExtField (genLHsVar from_label) hs_ty_arg + HsAppType noExtField (genLHsVar from_label) noHsTok hs_ty_arg , fvs ) } where hs_ty_arg = mkEmptyWildCardBndrs $ wrapGenSpan $ @@ -314,12 +314,12 @@ rnExpr (HsApp x fun arg) ; (arg',fvArg) <- rnLExpr arg ; return (HsApp x fun' arg', fvFun `plusFV` fvArg) } -rnExpr (HsAppType _ fun arg) +rnExpr (HsAppType _ fun at arg) = do { type_app <- xoptM LangExt.TypeApplications ; unless type_app $ addErr $ typeAppErr "type" $ hswc_body arg ; (fun',fvFun) <- rnLExpr fun ; (arg',fvArg) <- rnHsWcType HsTypeCtx arg - ; return (HsAppType NoExtField fun' arg', fvFun `plusFV` fvArg) } + ; return (HsAppType NoExtField fun' at arg', fvFun `plusFV` fvArg) } rnExpr (OpApp _ e1 op e2) = do { (e1', fv_e1) <- rnLExpr e1 @@ -2250,7 +2250,7 @@ isStrictPattern (L loc pat) = WildPat{} -> False VarPat{} -> False LazyPat{} -> False - AsPat _ _ p -> isStrictPattern p + AsPat _ _ _ p -> isStrictPattern p ParPat _ _ p _ -> isStrictPattern p ViewPat _ _ p -> isStrictPattern p SigPat _ p _ -> isStrictPattern p @@ -2423,7 +2423,7 @@ isReturnApp monad_names (L loc e) mb_pure = case e of _otherwise -> Nothing where is_var f (L _ (HsPar _ _ e _)) = is_var f e - is_var f (L _ (HsAppType _ e _)) = is_var f e + is_var f (L _ (HsAppType _ e _ _)) = is_var f e is_var f (L _ (HsVar _ (L _ r))) = f r -- TODO: I don't know how to get this right for rebindable syntax is_var _ _ = False diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 1755b6a1ef..be6dd17006 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -1325,7 +1325,7 @@ validRuleLhs foralls lhs check (OpApp _ e1 op e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2 check (HsApp _ e1 e2) = checkl e1 `mplus` checkl_e e2 - check (HsAppType _ e _) = checkl e + check (HsAppType _ e _ _) = checkl e check (HsVar _ lv) | (unLoc lv) `notElem` foralls = Nothing check other = Just other -- Failure diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index b64d1141e7..7886cebdf3 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -77,7 +77,7 @@ import GHC.Core.DataCon import GHC.Driver.Session ( getDynFlags, xopt_DuplicateRecordFields ) import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, ap, guard, forM, unless ) +import Control.Monad ( when, ap, guard, unless ) import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.Ratio @@ -551,10 +551,10 @@ rnPatAndThen mk (NPlusKPat _ rdr (L l lit) _ _ _ ) (L l lit') lit' ge minus) } -- The Report says that n+k patterns must be in Integral -rnPatAndThen mk (AsPat _ rdr pat) +rnPatAndThen mk (AsPat _ rdr at pat) = do { new_name <- newPatLName mk rdr ; pat' <- rnLPatAndThen mk pat - ; return (AsPat noExtField new_name pat') } + ; return (AsPat noExtField new_name at pat') } rnPatAndThen mk p@(ViewPat _ expr pat) = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns @@ -626,8 +626,7 @@ rnConPatAndThen :: NameMaker rnConPatAndThen mk con (PrefixCon tyargs pats) = do { con' <- lookupConCps con ; liftCps check_lang_exts - ; tyargs' <- forM tyargs $ \t -> - liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t + ; tyargs' <- mapM rnConPatTyArg tyargs ; pats' <- rnLPatsAndThen mk pats ; return $ ConPat { pat_con_ext = noExtField @@ -642,12 +641,15 @@ rnConPatAndThen mk con (PrefixCon tyargs pats) type_app <- xoptM LangExt.TypeApplications unless (scoped_tyvars && type_app) $ case listToMaybe tyargs of - Nothing -> pure () + Nothing -> pure () Just tyarg -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal visible type application in a pattern:" - <+> quotes (char '@' <> ppr tyarg)) + <+> quotes (ppr tyarg)) 2 (text "Both ScopedTypeVariables and TypeApplications are" <+> text "required to use this feature") + rnConPatTyArg (HsConPatTyArg at t) = do + t' <- liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t + return (HsConPatTyArg at t') rnConPatAndThen mk con (InfixCon pat1 pat2) = do { con' <- lookupConCps con diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index bb6cedf395..539b36ddc2 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -674,7 +674,7 @@ genHsVar :: Name -> HsExpr GhcRn genHsVar nm = HsVar noExtField $ wrapGenSpan nm genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn -genAppType expr = HsAppType noExtField (wrapGenSpan expr) . mkEmptyWildCardBndrs . wrapGenSpan +genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty)) genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn) genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit) |