diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-02-23 20:47:58 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-20 07:48:37 -0400 |
commit | f940fd466a86c2f8e93237b36835797be3f3c898 (patch) | |
tree | 53bf607d874a6b631f47a7ec091e3c2e501db366 | |
parent | 7d027433d30bdccf787197b28abfdcc1de263b89 (diff) | |
download | haskell-f940fd466a86c2f8e93237b36835797be3f3c898.tar.gz |
Add the main types to be used for exactprint in the GHC AST
The MR introducing the API Annotations, !2418 is huge.
Conceptually it is two parts, the one deals with introducing the new
types to be used for annotations, and outlining how they will be
used. This is a small change, localised to
compiler/GHC/Parser/Annotation.hs and is contained in this commit.
The follow-up, larger commit deals with mechanically working this
through the entire AST and updating all the parts affected by it.
It is being split so the part that needs good review feedback can be
seen in isolation, prior to the rest coming in.
-rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 1028 |
1 files changed, 964 insertions, 64 deletions
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index 33e48a1a50..9d158c95b7 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -1,27 +1,106 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} module GHC.Parser.Annotation ( + -- * Out-of-tree API Annotations. Exist for the duration of !5158, + -- * will be removed by !2418 getAnnotation, getAndRemoveAnnotation, getAnnotationComments,getAndRemoveAnnotationComments, ApiAnns(..), ApiAnnKey, + AddAnn(..), mkParensApiAnn, + + -- * Core API Annotation types AnnKeywordId(..), - AddAnn(..),mkParensApiAnn, AnnotationComment(..), IsUnicodeSyntax(..), unicodeAnn, HasE(..), - LRdrName -- Exists for haddocks only + + -- * In-tree Api Annotations + AddApiAnn(..), + AnnAnchor(..), annAnchorRealSrcSpan, + DeltaPos(..), + + ApiAnn, ApiAnn'(..), Anchor(..), AnchorOperation(..), + spanAsAnchor, realSpanAsAnchor, + noAnn, + + -- ** Comments in Annotations + + ApiAnnComments(..), LAnnotationComment, com, noCom, + getFollowingComments, setFollowingComments, setPriorComments, + ApiAnnCO, + + -- ** Annotations in 'GenLocated' + LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP, + SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, SrcSpanAnn'(..), + + -- ** Annotation data types used in 'GenLocated' + + AnnListItem(..), AnnList(..), + AnnParen(..), ParenType(..), parenTypeKws, + AnnPragma(..), + AnnContext(..), + NameAnn(..), NameAdornment(..), + NoApiAnns(..), + AnnSortKey(..), + + -- ** Trailing annotations in lists + TrailingAnn(..), addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN, + + -- ** Utilities for converting between different 'GenLocated' when + -- ** we do not care about the annotations. + la2na, na2la, n2l, l2n, l2l, la2la, + reLoc, reLocA, reLocL, reLocC, reLocN, + + la2r, realSrcSpan, + + -- ** Building up annotations + extraToAnnList, reAnn, + reAnnL, reAnnC, + addAnns, addAnnsA, widenSpan, widenAnchor, widenAnchorR, widenLocatedAn, + + -- ** Querying annotations + getLocAnn, + apiAnnAnns, apiAnnAnnsL, + annParen2AddApiAnn, + + -- ** Working with locations of annotations + sortLocatedA, + mapLocA, + combineLocsA, + combineSrcSpansA, + addCLocA, addCLocAA, + + -- ** Constructing 'GenLocated' annotation types when we do not care about annotations. + noLocA, getLocA, + noSrcSpanA, + noAnnSrcSpan, + + -- ** Working with comments in annotations + noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn, + addCommentsToApiAnn, setCommentsApiAnn, + transferComments, + + placeholderRealSpan, ) where import GHC.Prelude -import GHC.Types.Name.Reader -import GHC.Utils.Outputable -import GHC.Types.SrcLoc -import qualified Data.Map as Map import Data.Data - +import Data.Function (on) +import Data.List (sortBy) +import qualified Data.Map as Map +import Data.Semigroup +import GHC.Data.FastString +import GHC.Types.Name +import GHC.Types.SrcLoc +import GHC.Utils.Binary +import GHC.Utils.Outputable hiding ( (<>) ) +import GHC.Utils.Panic {- Note [Api annotations] @@ -34,22 +113,6 @@ elements from the original source: this includes keywords such as braces, and also comments. We collectively refer to this metadata as the "API annotations". -Rather than annotate the resulting parse tree with these locations -directly (this would be a major change to some fairly core data -structures in GHC), we instead capture locations for these elements in a -structure separate from the parse tree, and returned in the -pm_annotations field of the ParsedModule type. - -The full ApiAnns type is - -> data ApiAnns = -> ApiAnns -> { apiAnnItems :: Map.Map ApiAnnKey [RealSrcSpan], -> apiAnnEofPos :: Maybe RealSrcSpan, -> apiAnnComments :: Map.Map RealSrcSpan [RealLocated AnnotationComment], -> apiAnnRogueComments :: [RealLocated AnnotationComment] -> } - NON-COMMENT ELEMENTS Intuitively, every AST element directly contains a bag of keywords @@ -57,62 +120,31 @@ Intuitively, every AST element directly contains a bag of keywords can show up multiple times before the next AST element), each of which needs to be associated with its location in the original source code. -Consequently, the structure that records non-comment elements is logically -a two level map, from the RealSrcSpan of the AST element containing it, to -a map from keywords ('AnnKeyWord') to all locations of the keyword directly -in the AST element: - -> type ApiAnnKey = (RealSrcSpan,AnnKeywordId) -> -> Map.Map ApiAnnKey [RealSrcSpan] - -So - -> let x = 1 in 2 *x - -would result in the AST element - - L span (HsLet (binds for x = 1) (2 * x)) - -and the annotations - - (span,AnnLet) having the location of the 'let' keyword - (span,AnnEqual) having the location of the '=' sign - (span,AnnIn) having the location of the 'in' keyword +These keywords are recorded directly in the AST element in which they +occur, for the GhcPs phase. For any given element in the AST, there is only a set number of keywords that are applicable for it (e.g., you'll never see an 'import' keyword associated with a let-binding.) The set of allowed keywords is documented in a comment associated with the constructor of a given AST element, although the ground truth is in GHC.Parser -and GHC.Parser.PostProcess (which actually add the annotations; see #13012). +and GHC.Parser.PostProcess (which actually add the annotations). COMMENT ELEMENTS -Every comment is associated with a *located* AnnotationComment. We associate comments with the lowest (most specific) AST element enclosing them: -> Map.Map RealSrcSpan [RealLocated AnnotationComment] - PARSER STATE -There are three fields in PState (the parser state) which play a role +There is one field in PState (the parser state) which play a role with annotations. -> annotations :: [(ApiAnnKey,[RealSrcSpan])], -> comment_q :: [RealLocated AnnotationComment], -> annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])] - -The 'annotations' and 'annotations_comments' fields are simple: they simply -accumulate annotations that will end up in 'ApiAnns' at the end -(after they are passed to Map.fromList). +> comment_q :: [LAnnotationComment], The 'comment_q' field captures comments as they are seen in the token stream, so that when they are ready to be allocated via the parser they are -available (at the time we lex a comment, we don't know what the enclosing -AST node of it is, so we can't associate it with a RealSrcSpan in -annotations_comments). +available. PARSER EMISSION OF ANNOTATIONS @@ -136,7 +168,9 @@ https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations -} -- --------------------------------------------------------------------- --- If you update this, update the Note [Api annotations] above +-- This section should be removed when we move to the new APi Annotations + + data ApiAnns = ApiAnns { apiAnnItems :: Map.Map ApiAnnKey [RealSrcSpan], @@ -229,6 +263,7 @@ getAndRemoveAnnotationComments anns span = Nothing -> ([], anns) where ann_comments = apiAnnComments anns +-- End of section to be removed with new API Annotations -- -------------------------------------------------------------------- -- | API Annotations exist so that tools can perform source to source @@ -262,6 +297,7 @@ data AnnKeywordId | AnnCloseQ -- ^ '|]' | AnnCloseQU -- ^ '|]', unicode variant | AnnCloseP -- ^ ')' + | AnnClosePH -- ^ '\#)' | AnnCloseS -- ^ ']' | AnnColon | AnnComma -- ^ as a list separator @@ -304,7 +340,7 @@ data AnnKeywordId | AnnNewtype | AnnName -- ^ where a name loses its location in the AST, this carries it | AnnOf - | AnnOpen -- ^ '(\#' or '{-\# LANGUAGE' etc + | AnnOpen -- ^ '{-\# LANGUAGE' etc | AnnOpenB -- ^ '(|' | AnnOpenBU -- ^ '(|', unicode variant | AnnOpenC -- ^ '{' @@ -313,6 +349,7 @@ data AnnKeywordId | AnnOpenEQU -- ^ '[|', unicode variant | AnnOpenP -- ^ '(' | AnnOpenS -- ^ '[' + | AnnOpenPH -- ^ '(\#' | AnnDollar -- ^ prefix '$' -- TemplateHaskell | AnnDollarDollar -- ^ prefix '$$' -- TemplateHaskell | AnnPackageName @@ -378,8 +415,6 @@ instance Outputable AnnotationComment where -- 'GHC.Parser.Annotation.AnnRarrow' -- 'GHC.Parser.Annotation.AnnTilde' -- - May have 'GHC.Parser.Annotation.AnnComma' when in a list -type LRdrName = Located RdrName - -- | Certain tokens can have alternate representations when unicode syntax is -- enabled. This flag is attached to those tokens in the lexer so that the @@ -415,3 +450,868 @@ unicodeAnn ann = ann -- This type indicates whether the 'e' is present or not. data HasE = HasE | NoE deriving (Eq, Ord, Data, Show) + +-- --------------------------------------------------------------------- + +-- | Captures an annotation, storing the @'AnnKeywordId'@ and its +-- location. The parser only ever inserts @'AnnAnchor'@ fields with a +-- RealSrcSpan being the original location of the annotation in the +-- source file. +-- The @'AnnAnchor'@ can also store a delta position if the AST has been +-- modified and needs to be pretty printed again. +-- The usual way an 'AddApiAnn' is created is using the 'mj' ("make +-- jump") function, and then it can be inserted into the appropriate +-- annotation. +data AddApiAnn = AddApiAnn AnnKeywordId AnnAnchor deriving (Data,Show,Eq,Ord) + +-- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'AR'@ +-- variant, giving the exact location of the original item in the +-- parsed source. This can be replace by the @'AD'@ version, to +-- provide a position for the item relative to the end of the previous +-- item in the source. This is useful when editing an AST prior to +-- exact printing the changed one. +data AnnAnchor = AR RealSrcSpan + | AD DeltaPos + deriving (Data,Show,Eq,Ord) + +-- | Relative position, line then column. If 'deltaLine' is zero then +-- 'deltaColumn' gives the number of spaces between the end of the +-- preceding output element and the start of the one this is attached +-- to, on the same line. If 'deltaLine' is > 0, then it is the number +-- of lines to advance, and 'deltaColumn' is the start column on the +-- new line. +data DeltaPos = + DP + { deltaLine :: !Int, + deltaColumn :: !Int + } deriving (Show,Eq,Ord,Data) + + +annAnchorRealSrcSpan :: AnnAnchor -> RealSrcSpan +annAnchorRealSrcSpan (AR r) = r +annAnchorRealSrcSpan (AD _) = placeholderRealSpan + +instance Outputable AnnAnchor where + ppr (AR r) = text "AR" <+> ppr r + ppr (AD d) = text "AD" <+> ppr d + +instance Outputable AddApiAnn where + ppr (AddApiAnn kw ss) = text "AddApiAnn" <+> ppr kw <+> ppr ss + +-- --------------------------------------------------------------------- + +{- +Note [In-tree Api annotations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +GHC 7.10 brought in the concept of API Annotations, +https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations: + + The hsSyn AST does not directly capture the locations of certain + keywords and punctuation, such as 'let', 'in', 'do', etc. + + These locations are required by any tools wanting to parse a haskell + file, transform the AST in some way, and then regenerate the + original layout for the unchaged parts." + +These were returned in a separate data structure, linked to the main +AST via a combination of SrcSpan and constructor name. + +This indirect linkage kept the AST uncluttered, but made working with +the annotations complex, as two separate data structures had to be +changed at the same time in a coherent way. + +From GHC 9.2.1, these annotations are captured directly in the AST, +using the types in this file, and the Trees That Grow (TTG) extension +points for GhcPs. + +See Note [XRec and Anno in the AST] for details of how this is done. +-} + +-- | The API Annotations are now kept in the HsSyn AST for the GhcPs +-- phase. We do not always have API Annotations though, only for +-- parsed code. This type captures that, and allows the +-- representation decision to be easily revisited as it evolves. +-- +-- A goal of the annotations is that an AST can be edited, including +-- moving subtrees from one place to another, duplicating them, and so +-- on. This means that each fragment must be self-contained. To this +-- end, each annotated fragment keeps track of the anchor position it +-- was originally captured at, being simply the start span of the +-- topmost element of the ast fragment. This gives us a way to later +-- re-calculate all Located items in this layer of the AST, as well as +-- any annotations captured. The comments associated with the AST +-- fragment are also captured here. +-- +-- The 'ann' type parameter allows this general structure to be +-- specialised to the specific set of locations of original API +-- Annotation elements. So for 'HsLet' we have +-- +-- type instance XLet GhcPs = ApiAnn' AnnsLet +-- data AnnsLet +-- = AnnsLet { +-- alLet :: AnnAnchor, +-- alIn :: AnnAnchor +-- } deriving Data +-- +-- The spacing between the items under the scope of a given ApiAnn' is +-- derived from the original 'Anchor'. But there is no requirement +-- that the items included in the sub-element have a "matching" +-- location in their relative anchors. This allows us to freely move +-- elements around, and stitch together new AST fragments out of old +-- ones, and have them still printed out in a reasonable way. +data ApiAnn' ann + = ApiAnn { entry :: Anchor + -- ^ Base location for the start of the syntactic element + -- holding the annotations. + , anns :: ann -- ^ Annotations added by the Parser + , comments :: ApiAnnComments + -- ^ Comments enclosed in the SrcSpan of the element + -- this `ApiAnn'` is attached to + } + | ApiAnnNotUsed -- ^ No Annotation for generated code, + -- e.g. from TH, deriving, etc. + deriving (Data, Eq, Functor) + +-- | An 'Anchor' records the base location for the start of the +-- syntactic element holding the annotations, and is used as the point +-- of reference for calculating delta positions for contained +-- annotations. If an AST element is moved or deleted, the original +-- location is also tracked, for printing the source without gaps. +data Anchor = Anchor { anchor :: RealSrcSpan + -- ^ Base location for the start of + -- the syntactic element holding + -- the annotations. + , anchor_op :: AnchorOperation } + deriving (Data, Eq, Show) + +-- | If tools modify the parsed source, the 'MovedAnchor' variant can +-- directly provide the spacing for this item relative to the previous +-- one when printing. This allows AST fragments with a particular +-- anchor to be freely moved, without worrying about recalculating the +-- appropriate anchor span. +data AnchorOperation = UnchangedAnchor + | MovedAnchor DeltaPos + deriving (Data, Eq, Show) + + +spanAsAnchor :: SrcSpan -> Anchor +spanAsAnchor s = Anchor (realSrcSpan s) UnchangedAnchor + +realSpanAsAnchor :: RealSrcSpan -> Anchor +realSpanAsAnchor s = Anchor s UnchangedAnchor + +-- --------------------------------------------------------------------- + +-- | When we are parsing we add comments that belong a particular AST +-- element, and print them together with the element, interleaving +-- them into the output stream. But when editin the AST, to move +-- fragments around, it is useful to be able to first separate the +-- comments into those occuring before the AST element and those +-- following it. The 'AnnCommentsBalanced' constructor is used to do +-- this. The GHC parser will only insert the 'AnnComments' form. +data ApiAnnComments = AnnComments + { priorComments :: ![LAnnotationComment] } + | AnnCommentsBalanced + { priorComments :: ![LAnnotationComment] + , followingComments :: ![LAnnotationComment] } + deriving (Data, Eq) + +type LAnnotationComment = GenLocated Anchor AnnotationComment + +noCom :: ApiAnnComments +noCom = AnnComments [] + +com :: [LAnnotationComment] -> ApiAnnComments +com cs = AnnComments cs + +-- --------------------------------------------------------------------- + +-- | This type is the most direct mapping of the previous API +-- Annotations model. It captures the containing `SrcSpan' in its +-- `entry` `Anchor`, has a list of `AddApiAnn` as before, and keeps +-- track of the comments associated with the anchor. +type ApiAnn = ApiAnn' [AddApiAnn] + +-- --------------------------------------------------------------------- +-- Annotations attached to a 'SrcSpan'. +-- --------------------------------------------------------------------- + +-- | The 'SrcSpanAnn\'' type wraps a normal 'SrcSpan', together with +-- an extra annotation type. This is mapped to a specific `GenLocated` +-- usage in the AST through the `XRec` and `Anno` type families. +data SrcSpanAnn' a = SrcSpanAnn { ann :: a, locA :: SrcSpan } + deriving (Data, Eq) +-- See Note [XRec and Anno in the AST] + +-- | We mostly use 'SrcSpanAnn\'' with an 'ApiAnn\'' +type SrcAnn ann = SrcSpanAnn' (ApiAnn' ann) +-- AZ: is SrcAnn the right abbreviation here? Any better suggestions? + +-- AZ: should we rename LocatedA to LocatedL? The name comes from +-- this being the most common usage, and hence being the default +-- annotation. It also has a matching set if utility functions such as +-- locA, noLocA, etc. LocatedL would then need a new name, but it is +-- relatively rare, and captures a list having an openinc and closing +-- adorment, such as parens, braces, etc. +type LocatedA = GenLocated SrcSpanAnnA +type LocatedN = GenLocated SrcSpanAnnN + +type LocatedL = GenLocated SrcSpanAnnL +type LocatedP = GenLocated SrcSpanAnnP +type LocatedC = GenLocated SrcSpanAnnC + +type SrcSpanAnnA = SrcAnn AnnListItem +type SrcSpanAnnN = SrcAnn NameAnn + +type SrcSpanAnnL = SrcAnn AnnList +type SrcSpanAnnP = SrcAnn AnnPragma +type SrcSpanAnnC = SrcAnn AnnContext + +-- | General representation of a 'GenLocated' type carrying a +-- parameterised annotation type. +type LocatedAn an = GenLocated (SrcAnn an) + +{- +Note [XRec and Anno in the AST] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The API annotations are now captured directly inside the AST, using +TTG extension points. However certain annotations need to be captured +on the Located versions too. While there is a general form for these, +captured in the type SrcSpanAnn', there are also specific usages in +different contexts. + +Some of the particular use cases are + +1) RdrNames, which can have additional items such as backticks or parens + +2) Items which occur in lists, and the annotation relates purely +to its usage inside a list. + +See the section above this note for the rest. + +The Anno type family maps the specific SrcSpanAnn' variant for a given +item. + +So + + type instance XRec (GhcPass p) a = GenLocated (Anno a) a + type instance Anno RdrName = SrcSpanAnnN + type LocatedN = GenLocated SrcSpanAnnN + +meaning we can have type LocatedN RdrName + +-} + +-- --------------------------------------------------------------------- +-- Annotations for items in a list +-- --------------------------------------------------------------------- + +-- | Captures the location of punctuation occuring between items, +-- normally in a list. It is captured as a trailing annotation. +data TrailingAnn + = AddSemiAnn AnnAnchor -- ^ Trailing ';' + | AddCommaAnn AnnAnchor -- ^ Trailing ',' + | AddVbarAnn AnnAnchor -- ^ Trailing '|' + | AddRarrowAnn AnnAnchor -- ^ Trailing '->' + | AddRarrowAnnU AnnAnchor -- ^ Trailing '->', unicode variant + deriving (Data,Show,Eq, Ord) + +instance Outputable TrailingAnn where + ppr (AddSemiAnn ss) = text "AddSemiAnn" <+> ppr ss + ppr (AddCommaAnn ss) = text "AddCommaAnn" <+> ppr ss + ppr (AddVbarAnn ss) = text "AddVbarAnn" <+> ppr ss + ppr (AddRarrowAnn ss) = text "AddRarrowAnn" <+> ppr ss + ppr (AddRarrowAnnU ss) = text "AddRarrowAnnU" <+> ppr ss + +-- | Annotation for items appearing in a list. They can have one or +-- more trailing punctuations items, such as commas or semicolons. +data AnnListItem + = AnnListItem { + lann_trailing :: [TrailingAnn] + } + deriving (Data, Eq) + +-- --------------------------------------------------------------------- +-- Annotations for the context of a list of items +-- --------------------------------------------------------------------- + +-- | Annotation for the "container" of a list. This captures +-- surrounding items such as braces if present, and introductory +-- keywords such as 'where'. +data AnnList + = AnnList { + -- TODO:AZ: should we distinguish AnnList variants for lists + -- with layout and without? + al_anchor :: Maybe Anchor, -- ^ start point of a list having layout + al_open :: Maybe AddApiAnn, + al_close :: Maybe AddApiAnn, + al_rest :: [AddApiAnn], -- ^ context, such as 'where' keyword + al_trailing :: [TrailingAnn] + } deriving (Data,Eq) + +-- --------------------------------------------------------------------- +-- Annotations for parenthesised elements, such as tuples, lists +-- --------------------------------------------------------------------- + +-- | API Annotation for an item having surrounding "brackets", such as +-- tuples or lists +data AnnParen + = AnnParen { + ap_adornment :: ParenType, + ap_open :: AnnAnchor, + ap_close :: AnnAnchor + } deriving (Data) + +-- | Detail of the "brackets" used in an 'AnnParen' API Annotation. +data ParenType + = AnnParens -- ^ '(', ')' + | AnnParensHash -- ^ '(#', '#)' + | AnnParensSquare -- ^ '[', ']' + deriving (Eq, Ord, Data) + +-- | Maps the 'ParenType' to the related opening and closing +-- AnnKeywordId. Used when actually printing the item. +parenTypeKws :: ParenType -> (AnnKeywordId, AnnKeywordId) +parenTypeKws AnnParens = (AnnOpenP, AnnCloseP) +parenTypeKws AnnParensHash = (AnnOpenPH, AnnClosePH) +parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS) + +-- --------------------------------------------------------------------- + +-- | API Annotation for the 'Context' data type. +data AnnContext + = AnnContext { + ac_darrow :: Maybe (IsUnicodeSyntax, AnnAnchor), + -- ^ location and encoding of the '=>', if present. + ac_open :: [AnnAnchor], -- ^ zero or more opening parentheses. + ac_close :: [AnnAnchor] -- ^ zero or more closing parentheses. + } deriving (Data) + + +-- --------------------------------------------------------------------- +-- Annotations for names +-- --------------------------------------------------------------------- + +-- | API Annotations for a 'RdrName'. There are many kinds of +-- adornment that can be attached to a given 'RdrName'. This type +-- captures them, as detailed on the individual constructors. +data NameAnn + -- | Used for a name with an adornment, so '`foo`', '(bar)' + = NameAnn { + nann_adornment :: NameAdornment, + nann_open :: AnnAnchor, + nann_name :: AnnAnchor, + nann_close :: AnnAnchor, + nann_trailing :: [TrailingAnn] + } + -- | Used for @(,,,)@, or @(#,,,#)# + | NameAnnCommas { + nann_adornment :: NameAdornment, + nann_open :: AnnAnchor, + nann_commas :: [AnnAnchor], + nann_close :: AnnAnchor, + nann_trailing :: [TrailingAnn] + } + -- | Used for @()@, @(##)@, @[]@ + | NameAnnOnly { + nann_adornment :: NameAdornment, + nann_open :: AnnAnchor, + nann_close :: AnnAnchor, + nann_trailing :: [TrailingAnn] + } + -- | Used for @->@, as an identifier + | NameAnnRArrow { + nann_name :: AnnAnchor, + nann_trailing :: [TrailingAnn] + } + -- | Used for an item with a leading @'@. The annotation for + -- unquoted item is stored in 'nann_quoted'. + | NameAnnQuote { + nann_quote :: AnnAnchor, + nann_quoted :: SrcSpanAnnN, + nann_trailing :: [TrailingAnn] + } + -- | Used when adding a 'TrailingAnn' to an existing 'LocatedN' + -- which has no Api Annotation (via the 'ApiAnnNotUsed' constructor. + | NameAnnTrailing { + nann_trailing :: [TrailingAnn] + } + deriving (Data, Eq) + +-- | A 'NameAnn' can capture the locations of surrounding adornments, +-- such as parens or backquotes. This data type identifies what +-- particular pair are being used. +data NameAdornment + = NameParens -- ^ '(' ')' + | NameParensHash -- ^ '(#' '#)' + | NameBackquotes -- ^ '`' + | NameSquare -- ^ '[' ']' + deriving (Eq, Ord, Data) + +-- --------------------------------------------------------------------- + +-- | API Annotation used for capturing the locations of annotations in +-- pragmas. +data AnnPragma + = AnnPragma { + apr_open :: AddApiAnn, + apr_close :: AddApiAnn, + apr_rest :: [AddApiAnn] + } deriving (Data,Eq) + +-- --------------------------------------------------------------------- +-- | Captures the sort order of sub elements. This is needed when the +-- sub-elements have been split (as in a HsLocalBind which holds separate +-- binds and sigs) or for infix patterns where the order has been +-- re-arranged. It is captured explicitly so that after the Delta phase a +-- SrcSpan is used purely as an index into the annotations, allowing +-- transformations of the AST including the introduction of new Located +-- items or re-arranging existing ones. +data AnnSortKey + = NoAnnSortKey + | AnnSortKey [RealSrcSpan] + deriving (Data, Eq) + +-- --------------------------------------------------------------------- + + +-- | Helper function used in the parser to add a 'TrailingAnn' items +-- to an existing annotation. +addTrailingAnnToL :: SrcSpan -> TrailingAnn -> ApiAnnComments + -> ApiAnn' AnnList -> ApiAnn' AnnList +addTrailingAnnToL s t cs ApiAnnNotUsed + = ApiAnn (spanAsAnchor s) (AnnList (Just $ spanAsAnchor s) Nothing Nothing [] [t]) cs +addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n) + , comments = comments n <> cs } + where + addTrailing n = n { al_trailing = t : al_trailing n } + +-- | Helper function used in the parser to add a 'TrailingAnn' items +-- to an existing annotation. +addTrailingAnnToA :: SrcSpan -> TrailingAnn -> ApiAnnComments + -> ApiAnn' AnnListItem -> ApiAnn' AnnListItem +addTrailingAnnToA s t cs ApiAnnNotUsed + = ApiAnn (spanAsAnchor s) (AnnListItem [t]) cs +addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n) + , comments = comments n <> cs } + where + addTrailing n = n { lann_trailing = t : lann_trailing n } + +-- | Helper function used in the parser to add a comma location to an +-- existing annotation. +addTrailingCommaToN :: SrcSpan -> ApiAnn' NameAnn -> AnnAnchor -> ApiAnn' NameAnn +addTrailingCommaToN s ApiAnnNotUsed l + = ApiAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) noCom +addTrailingCommaToN _ n l = n { anns = addTrailing (anns n) l } + where + addTrailing :: NameAnn -> AnnAnchor -> NameAnn + addTrailing n l = n { nann_trailing = AddCommaAnn l : nann_trailing n } + +-- --------------------------------------------------------------------- + +-- |Helper function (temporary) during transition of names +-- Discards any annotations +l2n :: LocatedAn a1 a2 -> LocatedN a2 +l2n (L la a) = L (noAnnSrcSpan (locA la)) a + +n2l :: LocatedN a -> LocatedA a +n2l (L la a) = L (na2la la) a + +-- |Helper function (temporary) during transition of names +-- Discards any annotations +la2na :: SrcSpanAnn' a -> SrcSpanAnnN +la2na l = noAnnSrcSpan (locA l) + +-- |Helper function (temporary) during transition of names +-- Discards any annotations +la2la :: LocatedAn ann1 a2 -> LocatedAn ann2 a2 +la2la (L la a) = L (noAnnSrcSpan (locA la)) a + +l2l :: SrcSpanAnn' a -> SrcAnn ann +l2l l = noAnnSrcSpan (locA l) + +-- |Helper function (temporary) during transition of names +-- Discards any annotations +na2la :: SrcSpanAnn' a -> SrcAnn ann +na2la l = noAnnSrcSpan (locA l) + +reLoc :: LocatedAn a e -> Located e +reLoc (L (SrcSpanAnn _ l) a) = L l a + +reLocA :: Located e -> LocatedAn ann e +reLocA (L l a) = (L (SrcSpanAnn ApiAnnNotUsed l) a) + +reLocL :: LocatedN e -> LocatedA e +reLocL (L l a) = (L (na2la l) a) + +reLocC :: LocatedN e -> LocatedC e +reLocC (L l a) = (L (na2la l) a) + +reLocN :: LocatedN a -> Located a +reLocN (L (SrcSpanAnn _ l) a) = L l a + +-- --------------------------------------------------------------------- + +realSrcSpan :: SrcSpan -> RealSrcSpan +realSrcSpan (RealSrcSpan s _) = s +realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary + where + l = mkRealSrcLoc (fsLit "foo") (-1) (-1) + +la2r :: SrcSpanAnn' a -> RealSrcSpan +la2r l = realSrcSpan (locA l) + +extraToAnnList :: AnnList -> [AddApiAnn] -> AnnList +extraToAnnList (AnnList a o c e t) as = AnnList a o c (e++as) t + +reAnn :: [TrailingAnn] -> ApiAnnComments -> Located a -> LocatedA a +reAnn anns cs (L l a) = L (SrcSpanAnn (ApiAnn (spanAsAnchor l) (AnnListItem anns) cs) l) a + +reAnnC :: AnnContext -> ApiAnnComments -> Located a -> LocatedC a +reAnnC anns cs (L l a) = L (SrcSpanAnn (ApiAnn (spanAsAnchor l) anns cs) l) a + +reAnnL :: ann -> ApiAnnComments -> Located e -> GenLocated (SrcAnn ann) e +reAnnL anns cs (L l a) = L (SrcSpanAnn (ApiAnn (spanAsAnchor l) anns cs) l) a + +getLocAnn :: Located a -> SrcSpanAnnA +getLocAnn (L l _) = SrcSpanAnn ApiAnnNotUsed l + + +getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan +getLocA (L (SrcSpanAnn _ l) _) = l + +noLocA :: a -> LocatedAn an a +noLocA = L (SrcSpanAnn ApiAnnNotUsed noSrcSpan) + +noAnnSrcSpan :: SrcSpan -> SrcAnn ann +noAnnSrcSpan l = SrcSpanAnn ApiAnnNotUsed l + +noSrcSpanA :: SrcAnn ann +noSrcSpanA = noAnnSrcSpan noSrcSpan + +-- | Short form for 'ApiAnnNotUsed' +noAnn :: ApiAnn' a +noAnn = ApiAnnNotUsed + + +addAnns :: ApiAnn -> [AddApiAnn] -> ApiAnnComments -> ApiAnn +addAnns (ApiAnn l as1 cs) as2 cs2 + = ApiAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2) +addAnns ApiAnnNotUsed [] (AnnComments []) = ApiAnnNotUsed +addAnns ApiAnnNotUsed [] (AnnCommentsBalanced [] []) = ApiAnnNotUsed +addAnns ApiAnnNotUsed as cs = ApiAnn (Anchor placeholderRealSpan UnchangedAnchor) as cs + +-- AZ:TODO use widenSpan here too +addAnnsA :: SrcSpanAnnA -> [TrailingAnn] -> ApiAnnComments -> SrcSpanAnnA +addAnnsA (SrcSpanAnn (ApiAnn l as1 cs) loc) as2 cs2 + = SrcSpanAnn (ApiAnn l (AnnListItem (lann_trailing as1 ++ as2)) (cs <> cs2)) loc +addAnnsA (SrcSpanAnn ApiAnnNotUsed loc) [] (AnnComments []) + = SrcSpanAnn ApiAnnNotUsed loc +addAnnsA (SrcSpanAnn ApiAnnNotUsed loc) [] (AnnCommentsBalanced [] []) + = SrcSpanAnn ApiAnnNotUsed loc +addAnnsA (SrcSpanAnn ApiAnnNotUsed loc) as cs + = SrcSpanAnn (ApiAnn (spanAsAnchor loc) (AnnListItem as) cs) loc + +-- | The annotations need to all come after the anchor. Make sure +-- this is the case. +widenSpan :: SrcSpan -> [AddApiAnn] -> SrcSpan +widenSpan s as = foldl combineSrcSpans s (go as) + where + go [] = [] + go (AddApiAnn _ (AR s):rest) = RealSrcSpan s Nothing : go rest + go (AddApiAnn _ (AD _):rest) = go rest + +-- | The annotations need to all come after the anchor. Make sure +-- this is the case. +widenRealSpan :: RealSrcSpan -> [AddApiAnn] -> RealSrcSpan +widenRealSpan s as = foldl combineRealSrcSpans s (go as) + where + go [] = [] + go (AddApiAnn _ (AR s):rest) = s : go rest + go (AddApiAnn _ (AD _):rest) = go rest + +widenAnchor :: Anchor -> [AddApiAnn] -> Anchor +widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op + +widenAnchorR :: Anchor -> RealSrcSpan -> Anchor +widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op + +widenLocatedAn :: SrcSpanAnn' an -> [AddApiAnn] -> SrcSpanAnn' an +widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as) + +apiAnnAnnsL :: ApiAnn' a -> [a] +apiAnnAnnsL ApiAnnNotUsed = [] +apiAnnAnnsL (ApiAnn _ anns _) = [anns] + +apiAnnAnns :: ApiAnn -> [AddApiAnn] +apiAnnAnns ApiAnnNotUsed = [] +apiAnnAnns (ApiAnn _ anns _) = anns + +annParen2AddApiAnn :: ApiAnn' AnnParen -> [AddApiAnn] +annParen2AddApiAnn ApiAnnNotUsed = [] +annParen2AddApiAnn (ApiAnn _ (AnnParen pt o c) _) + = [AddApiAnn ai o, AddApiAnn ac c] + where + (ai,ac) = parenTypeKws pt + +-- TODO: enable when we migrate +-- apiAnnComments :: ApiAnn' an -> ApiAnnComments +-- apiAnnComments ApiAnnNotUsed = AnnComments [] +-- apiAnnComments (ApiAnn _ _ cs) = cs + +-- --------------------------------------------------------------------- +-- sortLocatedA :: [LocatedA a] -> [LocatedA a] +sortLocatedA :: [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e] +sortLocatedA = sortBy (leftmost_smallest `on` getLocA) + +mapLocA :: (a -> b) -> GenLocated SrcSpan a -> GenLocated (SrcAnn ann) b +mapLocA f (L l a) = L (noAnnSrcSpan l) (f a) + +-- AZ:TODO: move this somewhere sane + +combineLocsA :: Semigroup a => GenLocated (SrcSpanAnn' a) e1 -> GenLocated (SrcSpanAnn' a) e2 -> SrcSpanAnn' a +combineLocsA (L a _) (L b _) = combineSrcSpansA a b + +combineSrcSpansA :: Semigroup a => SrcSpanAnn' a -> SrcSpanAnn' a -> SrcSpanAnn' a +combineSrcSpansA (SrcSpanAnn aa la) (SrcSpanAnn ab lb) + = SrcSpanAnn (aa <> ab) (combineSrcSpans la lb) + +-- | Combine locations from two 'Located' things and add them to a third thing +addCLocA :: GenLocated (SrcSpanAnn' a) e1 -> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3 +addCLocA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (getLoc b)) c + +addCLocAA :: GenLocated (SrcSpanAnn' a1) e1 -> GenLocated (SrcSpanAnn' a2) e2 -> e3 -> GenLocated (SrcAnn ann) e3 +addCLocAA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (locA $ getLoc b)) c + +-- --------------------------------------------------------------------- +-- Utilities for manipulating ApiAnnComments +-- --------------------------------------------------------------------- + +getFollowingComments :: ApiAnnComments -> [LAnnotationComment] +getFollowingComments (AnnComments _) = [] +getFollowingComments (AnnCommentsBalanced _ cs) = cs + +setFollowingComments :: ApiAnnComments -> [LAnnotationComment] -> ApiAnnComments +setFollowingComments (AnnComments ls) cs = AnnCommentsBalanced ls cs +setFollowingComments (AnnCommentsBalanced ls _) cs = AnnCommentsBalanced ls cs + +setPriorComments :: ApiAnnComments -> [LAnnotationComment] -> ApiAnnComments +setPriorComments (AnnComments _) cs = AnnComments cs +setPriorComments (AnnCommentsBalanced _ ts) cs = AnnCommentsBalanced cs ts + +-- --------------------------------------------------------------------- +-- Comment-only annotations +-- --------------------------------------------------------------------- + +-- TODO:AZ I think ApiAnnCO is not needed +type ApiAnnCO = ApiAnn' NoApiAnns -- ^ Api Annotations for comments only + +data NoApiAnns = NoApiAnns + deriving (Data,Eq,Ord) + +noComments ::ApiAnnCO +noComments = ApiAnn (Anchor placeholderRealSpan UnchangedAnchor) NoApiAnns noCom + +-- TODO:AZ get rid of this +placeholderRealSpan :: RealSrcSpan +placeholderRealSpan = realSrcLocSpan (mkRealSrcLoc (mkFastString "placeholder") (-1) (-1)) + +comment :: RealSrcSpan -> ApiAnnComments -> ApiAnnCO +comment loc cs = ApiAnn (Anchor loc UnchangedAnchor) NoApiAnns cs + +-- --------------------------------------------------------------------- +-- Utilities for managing comments in an `ApiAnn' a` structure. +-- --------------------------------------------------------------------- + +-- | Add additional comments to a 'SrcAnn', used for manipulating the +-- AST prior to exact printing the changed one. +addCommentsToSrcAnn :: (Monoid ann) => SrcAnn ann -> ApiAnnComments -> SrcAnn ann +addCommentsToSrcAnn (SrcSpanAnn ApiAnnNotUsed loc) cs + = SrcSpanAnn (ApiAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc +addCommentsToSrcAnn (SrcSpanAnn (ApiAnn a an cs) loc) cs' + = SrcSpanAnn (ApiAnn a an (cs <> cs')) loc + +-- | Replace any existing comments on a 'SrcAnn', used for manipulating the +-- AST prior to exact printing the changed one. +setCommentsSrcAnn :: (Monoid ann) => SrcAnn ann -> ApiAnnComments -> SrcAnn ann +setCommentsSrcAnn (SrcSpanAnn ApiAnnNotUsed loc) cs + = SrcSpanAnn (ApiAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc +setCommentsSrcAnn (SrcSpanAnn (ApiAnn a an _) loc) cs + = SrcSpanAnn (ApiAnn a an cs) loc + +-- | Add additional comments, used for manipulating the +-- AST prior to exact printing the changed one. +addCommentsToApiAnn :: (Monoid a) + => SrcSpan -> ApiAnn' a -> ApiAnnComments -> ApiAnn' a +addCommentsToApiAnn loc ApiAnnNotUsed cs + = ApiAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs +addCommentsToApiAnn _ (ApiAnn a an ocs) ncs = ApiAnn a an (ocs <> ncs) + +-- | Replace any existing comments, used for manipulating the +-- AST prior to exact printing the changed one. +setCommentsApiAnn :: (Monoid a) + => SrcSpan -> ApiAnn' a -> ApiAnnComments -> ApiAnn' a +setCommentsApiAnn loc ApiAnnNotUsed cs + = ApiAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs +setCommentsApiAnn _ (ApiAnn a an _) cs = ApiAnn a an cs + +-- | Transfer comments from the annotations in one 'SrcAnn' to those +-- in another. The originals are not changed. This is used when +-- manipulating an AST prior to exact printing, +transferComments :: (Monoid ann) + => SrcAnn ann -> SrcAnn ann -> (SrcAnn ann, SrcAnn ann) +transferComments from@(SrcSpanAnn ApiAnnNotUsed _) to = (from, to) +transferComments (SrcSpanAnn (ApiAnn a an cs) l) to + = ((SrcSpanAnn (ApiAnn a an noCom) l), addCommentsToSrcAnn to cs) + +-- --------------------------------------------------------------------- +-- Semigroup instances, to allow easy combination of annotaion elements +-- --------------------------------------------------------------------- + +instance (Semigroup an) => Semigroup (SrcSpanAnn' an) where + (SrcSpanAnn a1 l1) <> (SrcSpanAnn a2 l2) = SrcSpanAnn (a1 <> a2) (combineSrcSpans l1 l2) + -- The critical part about the location is its left edge, and all + -- annotations must follow it. So we combine them which yields the + -- largest span + +instance (Semigroup a) => Semigroup (ApiAnn' a) where + ApiAnnNotUsed <> x = x + x <> ApiAnnNotUsed = x + (ApiAnn l1 a1 b1) <> (ApiAnn l2 a2 b2) = ApiAnn (l1 <> l2) (a1 <> a2) (b1 <> b2) + -- The critical part about the anchor is its left edge, and all + -- annotations must follow it. So we combine them which yields the + -- largest span + +instance Ord Anchor where + compare (Anchor s1 _) (Anchor s2 _) = compare s1 s2 + +instance Semigroup Anchor where + Anchor r1 o1 <> Anchor r2 _ = Anchor (combineRealSrcSpans r1 r2) o1 + +instance Semigroup ApiAnnComments where + AnnComments cs1 <> AnnComments cs2 = AnnComments (cs1 ++ cs2) + AnnComments cs1 <> AnnCommentsBalanced cs2 as2 = AnnCommentsBalanced (cs1 ++ cs2) as2 + AnnCommentsBalanced cs1 as1 <> AnnComments cs2 = AnnCommentsBalanced (cs1 ++ cs2) as1 + AnnCommentsBalanced cs1 as1 <> AnnCommentsBalanced cs2 as2 = AnnCommentsBalanced (cs1 ++ cs2) (as1++as2) + + +instance (Monoid a) => Monoid (ApiAnn' a) where + mempty = ApiAnnNotUsed + +instance Semigroup AnnListItem where + (AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2) + +instance Monoid AnnListItem where + mempty = AnnListItem [] + + +instance Semigroup AnnList where + (AnnList a1 o1 c1 r1 t1) <> (AnnList a2 o2 c2 r2 t2) + = AnnList (a1 <> a2) (c o1 o2) (c c1 c2) (r1 <> r2) (t1 <> t2) + where + -- Left biased combination for the open and close annotations + c Nothing x = x + c x Nothing = x + c f _ = f + +instance Monoid AnnList where + mempty = AnnList Nothing Nothing Nothing [] [] + +instance Semigroup NameAnn where + _ <> _ = panic "semigroup nameann" + +instance Monoid NameAnn where + mempty = NameAnnTrailing [] + + +instance Semigroup AnnSortKey where + NoAnnSortKey <> x = x + x <> NoAnnSortKey = x + AnnSortKey ls1 <> AnnSortKey ls2 = AnnSortKey (ls1 <> ls2) + +instance Monoid AnnSortKey where + mempty = NoAnnSortKey + +instance (Outputable a) => Outputable (ApiAnn' a) where + ppr (ApiAnn l a c) = text "ApiAnn" <+> ppr l <+> ppr a <+> ppr c + ppr ApiAnnNotUsed = text "ApiAnnNotUsed" + +instance Outputable Anchor where + ppr (Anchor a o) = text "Anchor" <+> ppr a <+> ppr o + +instance Outputable AnchorOperation where + ppr UnchangedAnchor = text "UnchangedAnchor" + ppr (MovedAnchor d) = text "MovedAnchor" <+> ppr d + +instance Outputable DeltaPos where + ppr (DP l c) = text "DP" <+> ppr l <+> ppr c + +instance Outputable (GenLocated Anchor AnnotationComment) where + ppr (L l c) = text "L" <+> ppr l <+> ppr c + +instance Outputable ApiAnnComments where + ppr (AnnComments cs) = text "AnnComments" <+> ppr cs + ppr (AnnCommentsBalanced cs ts) = text "AnnCommentsBalanced" <+> ppr cs <+> ppr ts + +instance (NamedThing (Located a)) => NamedThing (LocatedAn an a) where + getName (L l a) = getName (L (locA l) a) + +instance Outputable AnnContext where + ppr (AnnContext a o c) = text "AnnContext" <+> ppr a <+> ppr o <+> ppr c + +instance Outputable AnnSortKey where + ppr NoAnnSortKey = text "NoAnnSortKey" + ppr (AnnSortKey ls) = text "AnnSortKey" <+> ppr ls + +instance Outputable IsUnicodeSyntax where + ppr = text . show + +instance Binary a => Binary (LocatedL a) where + -- We do not serialise the annotations + put_ bh (L l x) = do + put_ bh (locA l) + put_ bh x + + get bh = do + l <- get bh + x <- get bh + return (L (noAnnSrcSpan l) x) + +instance (Outputable a) => Outputable (SrcSpanAnn' a) where + ppr (SrcSpanAnn a l) = text "SrcSpanAnn" <+> ppr a <+> ppr l + +instance (Outputable a, Outputable e) + => Outputable (GenLocated (SrcSpanAnn' a) e) where + ppr = pprLocated + +instance Outputable AnnListItem where + ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts + +instance Outputable NameAdornment where + ppr NameParens = text "NameParens" + ppr NameParensHash = text "NameParensHash" + ppr NameBackquotes = text "NameBackquotes" + ppr NameSquare = text "NameSquare" + +instance Outputable NameAnn where + ppr (NameAnn a o n c t) + = text "NameAnn" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t + ppr (NameAnnCommas a o n c t) + = text "NameAnnCommas" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t + ppr (NameAnnOnly a o c t) + = text "NameAnnOnly" <+> ppr a <+> ppr o <+> ppr c <+> ppr t + ppr (NameAnnRArrow n t) + = text "NameAnnRArrow" <+> ppr n <+> ppr t + ppr (NameAnnQuote q n t) + = text "NameAnnQuote" <+> ppr q <+> ppr n <+> ppr t + ppr (NameAnnTrailing t) + = text "NameAnnTrailing" <+> ppr t + +instance Outputable AnnList where + ppr (AnnList a o c r t) + = text "AnnList" <+> ppr a <+> ppr o <+> ppr c <+> ppr r <+> ppr t + +instance Outputable AnnPragma where + ppr (AnnPragma o c r) = text "AnnPragma" <+> ppr o <+> ppr c <+> ppr r |