diff options
| -rw-r--r-- | compiler/parser/Lexer.x | 13 | ||||
| -rw-r--r-- | compiler/parser/Parser.y | 6 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 8 |
3 files changed, 13 insertions, 14 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index edad2d90d7..e7e1028c96 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -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 diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 774b32f0ab..5f79879789 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -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 diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index b16858de56..b0d493c559 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -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 |