diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2015-05-21 14:13:42 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2015-05-21 14:13:42 +0200 |
| commit | c553e980e4a5d149af13bb705ec02819a15937ee (patch) | |
| tree | ab941f86fbc81d680db18cf8a740921d245582f8 /compiler/parser | |
| parent | 9f968e97a0de9c2509da00f6337b612dd72a0389 (diff) | |
| download | haskell-c553e980e4a5d149af13bb705ec02819a15937ee.tar.gz | |
ApiAnnotations : AST version of nested forall loses forall annotation
Summary:
When parsing
{-# LANGUAGE ScopedTypeVariables #-}
extremumNewton :: forall tag. forall tag1.
tag -> tag1 -> Int
extremumNewton = undefined
the parser creates nested HsForAllTy's for the two forall statements.
These get flattened into a single one in `HsTypes.mk_forall_ty`
This patch removes the flattening, so that API Annotations are not lost in the
process.
Test Plan: ./validate
Reviewers: goldfire, austin, simonpj
Reviewed By: simonpj
Subscribers: bgamari, mpickering, thomie, goldfire
Differential Revision: https://phabricator.haskell.org/D836
GHC Trac Issues: #10278, #10315, #10354, #10363
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 4 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 13 |
2 files changed, 12 insertions, 5 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 7ffa6b6a05..ed6f5ad4c8 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1523,11 +1523,11 @@ opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) } sigtype :: { LHsType RdrName } -- Always a HsForAllTy, -- to tell the renamer where to generalise - : ctype { sL1 $1 (mkImplicitHsForAllTy (noLoc []) $1) } + : ctype { sL1 $1 (mkImplicitHsForAllTy $1) } -- Wrap an Implicit forall if there isn't one there already sigtypedoc :: { LHsType RdrName } -- Always a HsForAllTy - : ctypedoc { sL1 $1 (mkImplicitHsForAllTy (noLoc []) $1) } + : ctypedoc { sL1 $1 (mkImplicitHsForAllTy $1) } -- Wrap an Implicit forall if there isn't one there already sig_vars :: { Located [Located RdrName] } -- Returned in reversed order diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 39589fe72c..5e2fa131cf 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -623,15 +623,22 @@ 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)) + +mkGadtDecl' :: [Located RdrName] + -> LHsType RdrName -- Always a HsForAllTy + -> P (ConDecl RdrName) + -- We allow C,D :: ty -- and expand it as if it had been -- C :: ty; D :: ty -- (Just like type signatures in general.) -mkGadtDecl _ ty@(L _ (HsForAllTy _ (Just l) _ _ _)) +mkGadtDecl' _ ty@(L _ (HsForAllTy _ (Just l) _ _ _)) = parseErrorSDoc l $ text "A constructor cannot have a partial type:" $$ ppr ty -mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) +mkGadtDecl' names (L ls (HsForAllTy imp Nothing qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] @@ -649,7 +656,7 @@ mkGadtDecl names (L ls (HsForAllTy imp Nothing qvars cxt tau)) , con_details = details , con_res = ResTyGADT ls res_ty , con_doc = Nothing } -mkGadtDecl _ other_ty = pprPanic "mkGadtDecl" (ppr other_ty) +mkGadtDecl' _ other_ty = pprPanic "mkGadtDecl" (ppr other_ty) tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName) tyConToDataCon loc tc |