diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/ApiAnnotation.hs | 3 | ||||
| -rw-r--r-- | compiler/parser/Parser.y | 25 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 12 |
3 files changed, 24 insertions, 16 deletions
diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs index babd93a0ab..0c80ec7270 100644 --- a/compiler/parser/ApiAnnotation.hs +++ b/compiler/parser/ApiAnnotation.hs @@ -233,6 +233,8 @@ data AnnKeywordId | AnnOpen -- ^ '(\#' or '{-\# LANGUAGE' etc | AnnOpenC -- ^ '{' | AnnOpenP -- ^ '(' + | AnnOpenPE -- ^ '$(' + | AnnOpenPTE -- ^ '$$(' | AnnOpenS -- ^ '[' | AnnPackageName | AnnPattern @@ -248,6 +250,7 @@ data AnnKeywordId | AnnThen | AnnThIdSplice -- ^ '$' | AnnThIdTySplice -- ^ '$$' + | AnnThTyQuote -- ^ double ''' | AnnTilde -- ^ '~' | AnnTildehsh -- ^ '~#' | AnnType diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 53a7b7c8d0..bc2bed8ad2 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1459,7 +1459,7 @@ ctypedoc :: { LHsType RdrName } >> return (sLL $1 $> $ mkQualifiedHsForAllTy $1 $3) } | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3)) - [mj AnnDcolon $2] } + [mj AnnVal $1,mj AnnDcolon $2] } | typedoc { $1 } ---------------------- @@ -1556,9 +1556,10 @@ atype :: { LHsType RdrName } [mop $1,mj AnnDcolon $3,mcp $5] } | quasiquote { sL1 $1 (HsQuasiQuoteTy (unLoc $1)) } | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy $2) - [mo $1,mc $3] } - | TH_ID_SPLICE { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ - mkUnqual varName (getTH_ID_SPLICE $1) } + [mj AnnOpenPE $1,mj AnnCloseP $3] } + | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ + mkUnqual varName (getTH_ID_SPLICE $1)) + [mj AnnThIdSplice $1] } -- see Note [Promotion] for the followings | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' @@ -1731,9 +1732,9 @@ gadt_constrs :: { Located [LConDecl RdrName] } gadt_constr :: { LConDecl RdrName } -- Returns a list because of: C,D :: ty : con_list '::' sigtype - {% do { gadtDecl <- mkGadtDecl (unLoc $1) $3 + {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3 ; ams (sLL $1 $> $ gadtDecl) - [mj AnnDcolon $2] } } + (mj AnnDcolon $2:anns) } } -- Deprecated syntax for GADT record declarations | oqtycon '{' fielddecls '}' '::' sigtype @@ -2180,8 +2181,8 @@ aexp2 :: { LHsExpr RdrName } | SIMPLEQUOTE qvar {% ams (sLL $1 $> $ HsBracket (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } | SIMPLEQUOTE qcon {% ams (sLL $1 $> $ HsBracket (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } - | TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThIdSplice $1,mj AnnName $2] } - | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThIdSplice $1,mj AnnName $2] } + | TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } + | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } | '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] } | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]} | '[t|' ctype '|]' {% checkNoPartialType @@ -2205,12 +2206,14 @@ splice_exp :: { LHsExpr RdrName } (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1)))) [mj AnnThIdSplice $1] } - | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE $2) [mo $1,mc $3] } + | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE $2) + [mj AnnOpenPE $1,mj AnnCloseP $3] } | TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE (sL1 $1 $ HsVar (mkUnqual varName (getTH_ID_TY_SPLICE $1)))) [mj AnnThIdTySplice $1] } - | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mo $1,mc $3] } + | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE $2) + [mj AnnOpenPTE $1,mj AnnCloseP $3] } cmdargs :: { [LHsCmdTop RdrName] } : cmdargs acmd { $2 : $1 } @@ -2279,7 +2282,7 @@ commas_tup_tail : commas tup_tail then [L (last $ fst $1) missingTupArg] else $2 in (head $ fst $1 - ,(map (\l -> L l missingTupArg) (init $ fst $1)) ++ tt)) } } + ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ tt)) } } -- Always follows a comma tup_tail :: { [LHsTupArg RdrName] } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index ed22808ab8..cc019d14bf 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -623,9 +623,12 @@ mkSimpleConDecl name qvars cxt details mkGadtDecl :: [Located RdrName] -> LHsType RdrName -- Always a HsForAllTy - -> P (ConDecl RdrName) -mkGadtDecl names (L l ty) - = mkGadtDecl' names (L l (flattenTopLevelHsForAllTy ty)) + -> P ([AddAnn], ConDecl RdrName) +mkGadtDecl names (L l ty) = do + let + (anns,ty') = flattenHsForAllTyKeepAnns ty + gadt <- mkGadtDecl' names (L l ty') + return (anns,gadt) mkGadtDecl' :: [Located RdrName] -> LHsType RdrName -- Always a HsForAllTy @@ -858,8 +861,7 @@ checkAPat msg loc e0 = do L _ (HsForAllTy Implicit _ _ (L _ []) ty) -> ty other -> other - return (SigPatIn e (mkHsWithBndrs - (L (getLoc t) (HsParTy t')))) + return (SigPatIn e (mkHsWithBndrs t')) -- n+k patterns OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ |