Commit bbd58fb5 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Fix #16133 by checking for TypeApplications in rnExpr

parent 3fb726d0
......@@ -35,7 +35,7 @@ import RnFixity
import RnUtils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
, bindLocalNames
, mapMaybeFvRn, mapFvRn
, warnUnusedLocalBinds )
, warnUnusedLocalBinds, typeAppErr )
import RnUnbound ( reportUnboundName )
import RnSplice ( rnBracket, rnSpliceExpr, checkThLocalName )
import RnTypes
......@@ -171,7 +171,9 @@ rnExpr (HsApp x fun arg)
; return (HsApp x fun' arg', fvFun `plusFV` fvArg) }
rnExpr (HsAppType x fun arg)
= do { (fun',fvFun) <- rnLExpr fun
= 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 x fun' arg', fvFun `plusFV` fvArg) }
......
......@@ -47,7 +47,7 @@ import RnHsDoc ( rnLHsDoc, rnMbLHsDoc )
import RnEnv
import RnUnbound ( perhapsForallMsg )
import RnUtils ( HsDocContext(..), withHsDocContext, mapFvRn
, pprHsDocContext, bindLocalNamesFV
, pprHsDocContext, bindLocalNamesFV, typeAppErr
, newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )
import RnFixity ( lookupFieldFixityRn, lookupFixityRn
, lookupTyFixityRn )
......@@ -645,7 +645,7 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
rnHsTyKi env (HsAppKindTy _ ty k)
= do { kind_app <- xoptM LangExt.TypeApplications
; unless kind_app (addErr (typeAppErr k))
; unless kind_app (addErr (typeAppErr "kind" k))
; (ty', fvs1) <- rnLHsTyKi env ty
; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
; return (HsAppKindTy noExt ty' k', fvs1 `plusFV` fvs2) }
......@@ -1477,10 +1477,6 @@ opTyErr op overall_ty
| otherwise
= text "Use TypeOperators to allow operators in types"
typeAppErr :: LHsKind GhcPs -> SDoc
typeAppErr (L _ k)
= hang (text "Illegal visible kind application" <+> quotes (ppr k))
2 (text "Perhaps you intended to use TypeApplications")
{-
************************************************************************
* *
......
......@@ -3,6 +3,7 @@
This module contains miscellaneous functions related to renaming.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
......@@ -14,7 +15,7 @@ module RnUtils (
warnUnusedMatches, warnUnusedTypePatterns,
warnUnusedTopBinds, warnUnusedLocalBinds,
mkFieldEnv,
unknownSubordinateErr, badQualBndrErr,
unknownSubordinateErr, badQualBndrErr, typeAppErr,
HsDocContext(..), pprHsDocContext,
inHsDocContext, withHsDocContext,
......@@ -363,6 +364,11 @@ badQualBndrErr :: RdrName -> SDoc
badQualBndrErr rdr_name
= text "Qualified name in binding position:" <+> ppr rdr_name
typeAppErr :: String -> LHsType GhcPs -> SDoc
typeAppErr what (L _ k)
= hang (text "Illegal visible" <+> text what <+> text "application"
<+> quotes (char '@' <> ppr k))
2 (text "Perhaps you intended to use TypeApplications")
checkTupSize :: Int -> RnM ()
checkTupSize tup_size
......
......@@ -330,6 +330,9 @@ renameDeriv is_boot inst_infos bagBinds
setXOptM LangExt.KindSignatures $
-- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
-- KindSignatures
setXOptM LangExt.TypeApplications $
-- GND/DerivingVia uses TypeApplications in generated code
-- (See Note [Newtype-deriving instances] in TcGenDeriv)
unsetXOptM LangExt.RebindableSyntax $
-- See Note [Avoid RebindableSyntax when deriving]
do {
......
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
module T16133 where
import Data.Kind
import Language.Haskell.TH hiding (Type)
data P (a :: k) = MkP
$([d| f :: Int
f = $(varE 'id `appTypeE` conT ''Int `appE` litE (integerL 42))
type P' = $(conT ''P `appKindT` conT ''Type) |])
T16133.hs:10:3: error:
Illegal visible kind application ‘@Type’
Perhaps you intended to use TypeApplications
T16133.hs:10:3: error:
Illegal visible type application ‘@Int’
Perhaps you intended to use TypeApplications
......@@ -465,3 +465,4 @@ test('T15845', normal, compile, ['-v0 -dsuppress-uniques'])
test('T15437', expect_broken(15437), multimod_compile,
['T15437', '-v0 ' + config.ghc_th_way_flags])
test('T15985', normal, compile, [''])
test('T16133', normal, compile_fail, [''])
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