diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Parser.y | 19 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 43 |
2 files changed, 23 insertions, 39 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 3043ba92b1..f1ddd6b961 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1884,9 +1884,9 @@ sigtypes1 :: { (OrdList (LHsSigType GhcPs)) } ----------------------------------------------------------------------------- -- Types -unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) } - : '{-# UNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getUNPACK_PRAGs $1, SrcUnpack) } - | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) } +unpackedness :: { Located UnpackednessPragma } + : '{-# UNPACK' '#-}' { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getUNPACK_PRAGs $1) SrcUnpack) } + | '{-# NOUNPACK' '#-}' { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getNOUNPACK_PRAGs $1) SrcNoUnpack) } forall_telescope :: { Located ([AddAnn], HsForAllTelescope GhcPs) } : 'forall' tv_bndrs '.' {% do { hintExplicitForall $1 @@ -1980,13 +1980,16 @@ tyapp :: { Located TyEl } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_AT atype { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) } - | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) } - | tyvarop { sL1 $1 $ TyElOpr (unLoc $1) } - | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) + | tyop { mapLoc TyElOpr $1 } + | unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) } + +tyop :: { Located RdrName } + : qtyconop { $1 } + | tyvarop { $1 } + | SIMPLEQUOTE qconop {% ams (sLL $1 $> (unLoc $2)) [mj AnnSimpleQuote $1,mj AnnVal $2] } - | SIMPLEQUOTE varop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) + | SIMPLEQUOTE varop {% ams (sLL $1 $> (unLoc $2)) [mj AnnSimpleQuote $1,mj AnnVal $2] } - | unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) } atype :: { LHsType GhcPs } : ntgtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- Not including unit tuples diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 1ceea73d88..24ceb1f3ea 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -70,6 +70,7 @@ module GHC.Parser.PostProcess ( addFatalError, hintBangPat, TyEl(..), mergeOps, mergeDataCon, mkBangTy, + UnpackednessPragma(..), -- Help with processing exports ImpExpSubSpec(..), @@ -559,25 +560,6 @@ As the result, in order to determine whether (C t1 t2) declares a data constructor, a type, or a context, we would need unlimited lookahead which 'happy' is not so happy with. -To further complicate matters, the interpretation of (!) and (~) is different -in constructors and types: - - (b1) type T = C ! D - (b2) data T = C ! D - (b3) data T = C ! D => E - -In (b1) and (b3), (!) is a type operator with two arguments: 'C' and 'D'. At -the same time, in (b2) it is a strictness annotation: 'C' is a data constructor -with a single strict argument 'D'. For the programmer, these cases are usually -easy to tell apart due to whitespace conventions: - - (b2) data T = C !D -- no space after the bang hints that - -- it is a strictness annotation - -For the parser, on the other hand, this whitespace does not matter. We cannot -tell apart (b2) from (b3) until we encounter (=>), so it requires unlimited -lookahead. - The solution that accounts for all of these issues is to initially parse data declarations and types as a reversed list of TyEl: @@ -1324,7 +1306,7 @@ isFunLhs e = go e [] [] data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs) | TyElKindApp SrcSpan (LHsType GhcPs) -- See Note [TyElKindApp SrcSpan interpretation] - | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness) + | TyElUnpackedness UnpackednessPragma {- Note [TyElKindApp SrcSpan interpretation] @@ -1345,20 +1327,15 @@ instance Outputable TyEl where ppr (TyElOpr name) = ppr name ppr (TyElOpd ty) = ppr ty ppr (TyElKindApp _ ki) = text "@" <> ppr ki - ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk + ppr (TyElUnpackedness (UnpackednessPragma _ _ unpk)) = ppr unpk -- | Extract a strictness/unpackedness annotation from the front of a reversed -- 'TyEl' list. pUnpackedness :: [Located TyEl] -- reversed TyEl - -> Maybe ( SrcSpan - , [AddAnn] - , SourceText - , SrcUnpackedness - , [Located TyEl] {- remaining TyEl -}) -pUnpackedness (L l x1 : xs) - | TyElUnpackedness (anns, prag, unpk) <- x1 - = Just (l, anns, prag, unpk, xs) + -> Maybe (SrcSpan, UnpackednessPragma, + [Located TyEl] {- remaining TyEl -}) +pUnpackedness (L l x1 : xs) | TyElUnpackedness up <- x1 = Just (l, up, xs) pUnpackedness _ = Nothing pBangTy @@ -1371,7 +1348,7 @@ pBangTy pBangTy lt@(L l1 _) xs = case pUnpackedness xs of Nothing -> (False, lt, pure (), xs) - Just (l2, anns, prag, unpk, xs') -> + Just (l2, UnpackednessPragma anns prag unpk, xs') -> let bl = combineSrcSpans l1 l2 bt = addUnpackedness (prag, unpk) lt in (True, L bl bt, addAnnsAt bl anns, xs') @@ -1380,6 +1357,10 @@ mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs mkBangTy strictness = HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness) +-- Result of parsing {-# UNPACK #-} or {-# NOUNPACK #-} +data UnpackednessPragma = + UnpackednessPragma [AddAnn] SourceText SrcUnpackedness + addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t)) | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang @@ -1411,7 +1392,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs -- clause [unpk]: -- handle (NO)UNPACK pragmas - go k acc ops_acc ((L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) = + go k acc ops_acc ((L l (TyElUnpackedness (UnpackednessPragma anns unpkSrc unpk))):xs) = if not (null acc) && null xs then do { acc' <- eitherToP $ mergeOpsAcc acc ; let a = ops_acc acc' |