diff options
| author | Richard Eisenberg <rae@richarde.dev> | 2019-08-18 16:02:50 +0200 |
|---|---|---|
| committer | Richard Eisenberg <rae@richarde.dev> | 2020-03-17 13:46:57 +0000 |
| commit | 53ff2cd0c49735e8f709ac8a5ceab68483eb89df (patch) | |
| tree | 2c22014de33e6d0fcdfef7e5436ff0abc7e0fca1 /compiler/GHC/Hs | |
| parent | 75168d07c9c30289709423fc184bbab8dcad0f4e (diff) | |
| download | haskell-53ff2cd0c49735e8f709ac8a5ceab68483eb89df.tar.gz | |
Fix #17021 by checking more return kinds
All the details are in new Note [Datatype return kinds] in
TcTyClsDecls.
Test case: typecheck/should_fail/T17021{,b}
typecheck/should_compile/T17021a
Updates haddock submodule
Diffstat (limited to 'compiler/GHC/Hs')
| -rw-r--r-- | compiler/GHC/Hs/Utils.hs | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index b3a327c4c6..d7f37dac86 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -498,8 +498,21 @@ nlHsTyVar x = noLoc (HsTyVar noExtField NotPromoted (noLoc x)) nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b) nlHsParTy t = noLoc (HsParTy noExtField t) -nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) -nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys +nlHsTyConApp :: LexicalFixity -> IdP (GhcPass p) + -> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p) +nlHsTyConApp fixity tycon tys + | Infix <- fixity + , HsValArg ty1 : HsValArg ty2 : rest <- tys + = foldl' mk_app (noLoc $ HsOpTy noExtField ty1 (noLoc tycon) ty2) rest + | otherwise + = foldl' mk_app (nlHsTyVar tycon) tys + where + mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p) + mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLoc $ HsParTy noExtField fun) arg + -- parenthesize things like `(A + B) C` + mk_app fun (HsValArg ty) = noLoc (HsAppTy noExtField fun (parenthesizeHsType appPrec ty)) + mk_app fun (HsTypeArg _ ki) = noLoc (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki)) + mk_app fun (HsArgPar _) = noLoc (HsParTy noExtField fun) nlHsAppKindTy :: LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p) |