diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-09-20 19:25:22 +0100 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2020-09-20 19:25:22 +0100 |
| commit | f91ea170d86fab45a9f4658b8b02f4adede9aef7 (patch) | |
| tree | 4aa407ee0580f7b0bc5e872d2dbf8537737e2cc9 | |
| parent | 23f34f7be335f94dcebb7459008d4b1cfa926e3e (diff) | |
| download | haskell-wip/az/ghc-9.0-anns-2.tar.gz | |
API Annotations: Fix annotation for strictnesswip/az/ghc-9.0-anns-2
This adds the correct location for a ! or ~.
It is a reconstruction of 3ccc80ee6120db7ead579c6e9fc5c2164f3bf575,
some of which got mangled in the backport process.
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 5e7c9d8f04..e591f241d0 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -1374,19 +1374,24 @@ pBangTy lt@(L l1 _) xs = Nothing -> (False, lt, pure (), xs) Just (l2, anns, prag, unpk, xs') -> let bl = combineSrcSpans l1 l2 - bt = addUnpackedness (prag, unpk) lt - in (True, L bl bt, addAnnsAt bl anns, xs') + (anns2, bt) = addUnpackedness (prag, unpk) lt + in (True, L bl bt, addAnnsAt bl (anns ++ anns2), xs') mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs mkBangTy strictness = HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness) -addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs -addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t)) +addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> ([AddAnn], HsType GhcPs) +addUnpackedness (prag, unpk) (L l (HsBangTy x bang t)) | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang - = HsBangTy x (HsSrcBang prag unpk strictness) t + = let + anns = case strictness of + SrcLazy -> [AddAnn AnnTilde (srcSpanFirstCharacter l)] + SrcStrict -> [AddAnn AnnBang (srcSpanFirstCharacter l)] + NoSrcStrict -> [] + in (anns, HsBangTy x (HsSrcBang prag unpk strictness) t) addUnpackedness (prag, unpk) t - = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t + = ([], HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t) -- | Merge a /reversed/ and /non-empty/ soup of operators and operands -- into a type. |