Commit 284a2f44 authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot
Browse files

Decouple AddAnn from P

parent 0670f98a
......@@ -59,7 +59,8 @@ module Lexer (
getLexState, popLexState, pushLexState,
ExtBits(..),
lexTokenStream,
AddAnn,mkParensApiAnn,
AddAnn(..),mkParensApiAnn,
addAnnsAt,
commentToAnnotation
) where
......@@ -2503,7 +2504,6 @@ class Monad m => MonadP m where
-- | Check if a given flag is currently set in the bitmap.
getBit :: ExtBits -> m Bool
-- | Given a location and a list of AddAnn, apply them all to the location.
addAnnsAt :: SrcSpan -> [AddAnn] -> m ()
addAnnotation :: SrcSpan -- SrcSpan of enclosing AST construct
-> AnnKeywordId -- The first two parameters are the key
-> SrcSpan -- The location of the keyword itself
......@@ -2533,11 +2533,13 @@ instance MonadP P where
addError span msg >> P PFailed
getBit ext = P $ \s -> let b = ext `xtest` pExtsBitmap (options s)
in b `seq` POk s b
addAnnsAt loc anns = mapM_ (\a -> a loc) anns
addAnnotation l a v = do
addAnnotationOnly l a v
allocateComments l
addAnnsAt :: MonadP m => SrcSpan -> [AddAnn] -> m ()
addAnnsAt l = mapM_ (\(AddAnn a v) -> addAnnotation l a v)
addTabWarning :: RealSrcSpan -> P ()
addTabWarning srcspan
= P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->
......@@ -3061,7 +3063,7 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag))
--
-- The usual way an 'AddAnn' is created is using the 'mj' ("make jump")
-- function, and then it can be discharged using the 'ams' function.
type AddAnn = SrcSpan -> P ()
data AddAnn = AddAnn AnnKeywordId SrcSpan
addAnnotationOnly :: SrcSpan -> AnnKeywordId -> SrcSpan -> P ()
addAnnotationOnly l a v = P $ \s -> POk s {
......@@ -3073,9 +3075,8 @@ addAnnotationOnly l a v = P $ \s -> POk s {
-- and end of the span
mkParensApiAnn :: SrcSpan -> [AddAnn]
mkParensApiAnn (UnhelpfulSpan _) = []
mkParensApiAnn s@(RealSrcSpan ss) = [mj AnnOpenP lo,mj AnnCloseP lc]
mkParensApiAnn s@(RealSrcSpan ss) = [AddAnn AnnOpenP lo,AddAnn AnnCloseP lc]
where
mj a l = (\s -> addAnnotation s a l)
f = srcSpanFile ss
sl = srcSpanStartLine ss
sc = srcSpanStartCol ss
......
......@@ -3996,10 +3996,10 @@ in ApiAnnotation.hs
-- |Construct an AddAnn from the annotation keyword and the location
-- of the keyword itself
mj :: HasSrcSpan e => AnnKeywordId -> e -> AddAnn
mj a l s = addAnnotation s a (gl l)
mj a l = AddAnn a (gl l)
mjL :: AnnKeywordId -> SrcSpan -> AddAnn
mjL a l s = addAnnotation s a l
mjL = AddAnn
......@@ -4007,7 +4007,7 @@ mjL a l s = addAnnotation s a l
-- the token has a unicode equivalent and this has been used, provide the
-- unicode variant of the annotation.
mu :: AnnKeywordId -> Located Token -> AddAnn
mu a lt@(dL->L l t) = (\s -> addAnnotation s (toUnicodeAnn a lt) l)
mu a lt@(dL->L l t) = AddAnn (toUnicodeAnn a lt) l
-- | If the 'Token' is using its unicode variant return the unicode variant of
-- the annotation
......
......@@ -266,7 +266,7 @@ mkDataFamInst :: SrcSpan
mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
ksig data_cons maybe_deriv
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
; return (cL loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs
(FamEqn { feqn_ext = noExtField
......@@ -1374,12 +1374,12 @@ pStrictMark ((dL->L l1 x1) : (dL->L l2 x2) : xs)
| Just (strAnnId, str) <- tyElStrictness x1
, TyElUnpackedness (unpkAnns, prag, unpk) <- x2
= Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)
, unpkAnns ++ [\s -> addAnnotation s strAnnId l1]
, unpkAnns ++ [AddAnn strAnnId l1]
, xs )
pStrictMark ((dL->L l x1) : xs)
| Just (strAnnId, str) <- tyElStrictness x1
= Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)
, [\s -> addAnnotation s strAnnId l]
, [AddAnn strAnnId l]
, xs )
pStrictMark ((dL->L l x1) : xs)
| TyElUnpackedness (anns, prag, unpk) <- x1
......@@ -3025,8 +3025,6 @@ instance MonadP PV where
PV $ ReaderT $ \ctxMsg -> addFatalError srcspan (msg $$ ctxMsg)
getBit ext =
PV $ ReaderT $ \_ -> getBit ext
addAnnsAt loc anns =
PV $ ReaderT $ \_ -> addAnnsAt loc anns
addAnnotation l a v =
PV $ ReaderT $ \_ -> addAnnotation l a v
......
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