diff options
Diffstat (limited to 'compiler/parser/Parser.y.pp')
| -rw-r--r-- | compiler/parser/Parser.y.pp | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index af297531e2..b35bbf38b4 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -59,6 +59,7 @@ import Type ( funTyCon ) import ForeignCall import OccName ( varName, dataName, tcClsName, tvName ) import DataCon ( DataCon, dataConName ) +import CoAxiom ( Role(..) ) import SrcLoc import Module import Kind ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind ) @@ -273,6 +274,9 @@ incorrect. 'group' { L _ ITgroup } -- for list transform extension 'by' { L _ ITby } -- for list transform extension 'using' { L _ ITusing } -- for list transform extension + 'N' { L _ ITnominal } -- Nominal role + 'R' { L _ ITrepresentational } -- Representational role + 'P' { L _ ITphantom } -- Phantom role '{-# INLINE' { L _ (ITinline_prag _ _) } '{-# SPECIALISE' { L _ ITspec_prag } @@ -1129,6 +1133,7 @@ atype :: { LHsType RdrName } | '[:' ctype ':]' { LL $ HsPArrTy $2 } | '(' ctype ')' { LL $ HsParTy $2 } | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 } + | atype '@' role { LL $ HsRoleAnnot $1 (unLoc $3) } | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) } | '$(' exp ')' { LL $ mkHsSpliceTy $2 } | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $ @@ -1166,8 +1171,8 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] } | {- empty -} { [] } tv_bndr :: { LHsTyVarBndr RdrName } - : tyvar { L1 (UserTyVar (unLoc $1)) } - | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) $4) } + : tyvar { L1 (HsTyVarBndr (unLoc $1) Nothing Nothing) } + | '(' tyvar '::' kind ')' { LL (HsTyVarBndr (unLoc $2) (Just $4) Nothing) } fds :: { Located [Located (FunDep RdrName)] } : {- empty -} { noLoc [] } @@ -1185,6 +1190,11 @@ varids0 :: { Located [RdrName] } : {- empty -} { noLoc [] } | varids0 tyvar { LL (unLoc $2 : unLoc $1) } +role :: { Located Role } + : 'N' { LL Nominal } + | 'R' { LL Representational } + | 'P' { LL Phantom } + ----------------------------------------------------------------------------- -- Kinds @@ -1926,7 +1936,7 @@ qtycon :: { Located RdrName } -- Qualified or unqualified | tycon { $1 } tycon :: { Located RdrName } -- Unqualified - : CONID { L1 $! mkUnqual tcClsName (getCONID $1) } + : upcase_id { L1 $! mkUnqual tcClsName (unLoc $1) } qtyconsym :: { Located RdrName } : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) } @@ -2071,7 +2081,7 @@ qconid :: { Located RdrName } -- Qualified or unqualified | PREFIXQCONSYM { L1 $! mkQual dataName (getPREFIXQCONSYM $1) } conid :: { Located RdrName } - : CONID { L1 $ mkUnqual dataName (getCONID $1) } + : upcase_id { L1 $ mkUnqual dataName (unLoc $1) } qconsym :: { Located RdrName } -- Qualified or unqualified : consym { $1 } @@ -2108,7 +2118,7 @@ close :: { () } -- Miscellaneous (mostly renamings) modid :: { Located ModuleName } - : CONID { L1 $ mkModuleNameFS (getCONID $1) } + : upcase_id { L1 $ mkModuleNameFS (unLoc $1) } | QCONID { L1 $ let (mod,c) = getQCONID $1 in mkModuleNameFS (mkFastString @@ -2119,6 +2129,12 @@ commas :: { Int } -- One or more commas : commas ',' { $1 + 1 } | ',' { 1 } +upcase_id :: { Located FastString } + : CONID { L1 $! getCONID $1 } + | 'N' { L1 (fsLit "N") } + | 'R' { L1 (fsLit "R") } + | 'P' { L1 (fsLit "P") } + ----------------------------------------------------------------------------- -- Documentation comments |