Commit 8dbee2c5 authored by Alan Zimmerman's avatar Alan Zimmerman
Browse files

Api Annotations : Adjust SrsSpans for prefix bang (!).

And prefix ~
parent 59984655
Pipeline #23142 failed with stages
in 311 minutes and 32 seconds
......@@ -2614,7 +2614,7 @@ aexp :: { ECP }
amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] }
| PREFIX_BANG aexp { ECP $
runECP_PV $2 >>= \ $2 ->
amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1,mj AnnVal $2] }
amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1] }
| PREFIX_MINUS aexp { ECP $
runECP_PV $2 >>= \ $2 ->
amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] }
......
......@@ -1231,13 +1231,14 @@ makeFunBind fn ms
checkPatBind :: LPat GhcPs
-> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
-> P ([AddAnn],HsBind GhcPs)
checkPatBind lhs (L match_span (_,grhss))
checkPatBind lhs (L rhs_span (_,grhss))
| BangPat _ p <- unLoc lhs
, VarPat _ v <- unLoc p
= return ([], makeFunBind v [L match_span (m v)])
where
match_span = combineSrcSpans (getLoc lhs) rhs_span
m v = Match { m_ext = noExtField
, m_ctxt = FunRhs { mc_fun = L (getLoc lhs) (unLoc v)
, m_ctxt = FunRhs { mc_fun = v
, mc_fixity = Prefix
, mc_strictness = SrcStrict }
, m_pats = []
......@@ -1373,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.
......
......@@ -39,7 +39,8 @@ listcomps:
.PHONY: T10358
T10358:
$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs
# Ignore result code, we have an unattached (superfluous) AnnBang
- $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs
.PHONY: T10396
T10396:
......
---Unattached Annotation Problems (should be empty list)---
[]
[(AnnBang, Test10358.hs:5:19)]
---Ann before enclosing span problem (should be empty list)---
[
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment