diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y.pp | 5 | ||||
| -rw-r--r-- | compiler/parser/ParserCore.y | 4 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 8 |
3 files changed, 11 insertions, 6 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index ff98b748c9..8de1e0b03f 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -871,7 +871,7 @@ rule_var_list :: { [RuleBndr RdrName] } rule_var :: { RuleBndr RdrName } : varid { RuleBndr $1 } - | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 } + | '(' varid '::' ctype ')' { RuleBndrSig $2 (HsBSig $4 placeHolderBndrs) } ----------------------------------------------------------------------------- -- Warnings and deprecations (c.f. rules) @@ -1102,7 +1102,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] } tv_bndr :: { LHsTyVarBndr RdrName } : tyvar { L1 (UserTyVar (unLoc $1) placeHolderKind) } - | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) $4 placeHolderKind) } + | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) (HsBSig $4 placeHolderBndrs) placeHolderKind) } fds :: { Located [Located (FunDep RdrName)] } : {- empty -} { noLoc [] } @@ -1135,6 +1135,7 @@ akind :: { LHsKind RdrName } : '*' { L1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) } | '(' kind ')' { LL $ HsParTy $2 } | pkind { $1 } + | tyvar { L1 $ HsTyVar (unLoc $1) } pkind :: { LHsKind RdrName } -- promoted type, see Note [Promotion] : qtycon { L1 $ HsTyVar $ unLoc $1 } diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y index 80d49430eb..872bcdefc0 100644 --- a/compiler/parser/ParserCore.y +++ b/compiler/parser/ParserCore.y @@ -375,7 +375,9 @@ ifaceUnliftedTypeKind = ifaceTcType (IfaceTc unliftedTypeKindTyConName) ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName -toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) (toHsKind k) placeHolderKind +toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig placeHolderKind + where + bsig = HsBSig (toHsKind k) placeHolderBndrs ifaceExtRdrName :: Name -> RdrName ifaceExtRdrName name = mkOrig (nameModule name) (nameOccName name) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 59e6727535..be1f5c4f4b 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -218,7 +218,9 @@ mkTySynonym :: SrcSpan mkTySynonym loc is_family lhs rhs = do { (tc, tparams) <- checkTyClHdr lhs ; (tyvars, typats) <- checkTParams is_family lhs tparams - ; return (L loc (TySynonym tc tyvars typats rhs)) } + ; return (L loc (TySynonym { tcdLName = tc + , tcdTyVars = tyvars, tcdTyPats = typats + , tcdSynRhs = rhs, tcdFVs = placeHolderNames })) } mkTyFamily :: SrcSpan -> FamilyFlavour @@ -499,7 +501,7 @@ checkTyVars tycl_hdr tparms = mapM chk tparms where -- Check that the name space is correct! chk (L l (HsKindSig (L _ (HsTyVar tv)) k)) - | isRdrTyVar tv = return (L l (KindedTyVar tv k placeHolderKind)) + | isRdrTyVar tv = return (L l (KindedTyVar tv (HsBSig k placeHolderBndrs) placeHolderKind)) chk (L l (HsTyVar tv)) | isRdrTyVar tv = return (L l (UserTyVar tv placeHolderKind)) chk t@(L l _) @@ -636,7 +638,7 @@ checkAPat dynflags loc e0 = case e0 of let t' = case t of L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty other -> other - return (SigPatIn e t') + return (SigPatIn e (HsBSig t' placeHolderBndrs)) -- n+k patterns OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ |