diff options
Diffstat (limited to 'compiler/Language/Haskell/Syntax/Expr.hs')
| -rw-r--r-- | compiler/Language/Haskell/Syntax/Expr.hs | 60 |
1 files changed, 41 insertions, 19 deletions
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs index 9967a78314..cb84d25489 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -143,26 +143,37 @@ values (see function @mkRdrRecordUpd@ in 'GHC.Parser.PostProcess'). -- | RecordDotSyntax field updates -newtype FieldLabelStrings = - FieldLabelStrings [Located FieldLabelString] - deriving (Data) +newtype FieldLabelStrings p = + FieldLabelStrings [Located (HsFieldLabel p)] -instance Outputable FieldLabelStrings where +instance Outputable (FieldLabelStrings p) where ppr (FieldLabelStrings flds) = hcat (punctuate dot (map (ppr . unLoc) flds)) +instance OutputableBndr (FieldLabelStrings p) where + pprInfixOcc = pprFieldLabelStrings + pprPrefixOcc = pprFieldLabelStrings + +pprFieldLabelStrings :: FieldLabelStrings p -> SDoc +pprFieldLabelStrings (FieldLabelStrings flds) = + hcat (punctuate dot (map (ppr . unLoc) flds)) + +instance Outputable (HsFieldLabel p) where + ppr (HsFieldLabel _ s) = ppr s + ppr XHsFieldLabel{} = text "XHsFieldLabel" + -- Field projection updates (e.g. @foo.bar.baz = 1@). See Note -- [RecordDotSyntax field updates]. -type RecProj arg = HsRecField' FieldLabelStrings arg +type RecProj p arg = HsRecField' (FieldLabelStrings p) arg -- The phantom type parameter @p@ is for symmetry with @LHsRecField p -- arg@ in the definition of @data Fbind@ (see GHC.Parser.Process). -type LHsRecProj p arg = Located (RecProj arg) +type LHsRecProj p arg = XRec p (RecProj p arg) -- These two synonyms are used in the definition of syntax @RecordUpd@ -- below. -type RecUpdProj p = RecProj (LHsExpr p) -type LHsRecUpdProj p = Located (RecUpdProj p) +type RecUpdProj p = RecProj p (LHsExpr p) +type LHsRecUpdProj p = XRec p (RecUpdProj p) {- ************************************************************************ @@ -366,7 +377,7 @@ data HsExpr p -- Note [ExplicitTuple] | ExplicitTuple (XExplicitTuple p) - [LHsTupArg p] + [HsTupArg p] Boxity -- | Used for unboxed sum types @@ -419,7 +430,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsLet (XLet p) - (LHsLocalBinds p) + (HsLocalBinds p) (LHsExpr p) -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo', @@ -483,7 +494,7 @@ data HsExpr p | HsGetField { gf_ext :: XGetField p , gf_expr :: LHsExpr p - , gf_field :: Located FieldLabelString + , gf_field :: Located (HsFieldLabel p) } -- | Record field selector. e.g. @(.x)@ or @(.x.y)@ @@ -496,7 +507,7 @@ data HsExpr p | HsProjection { proj_ext :: XProjection p - , proj_flds :: [Located FieldLabelString] + , proj_flds :: [Located (HsFieldLabel p)] } -- | Expression with an explicit type signature. @e :: type@ @@ -611,6 +622,15 @@ type family PendingTcSplice' p -- --------------------------------------------------------------------- +data HsFieldLabel p + = HsFieldLabel + { hflExt :: XCHsFieldLabel p + , hflLabel :: Located FieldLabelString + } + | XHsFieldLabel !(XXHsFieldLabel p) + +-- --------------------------------------------------------------------- + -- | A pragma, written as {-# ... #-}, that may appear within an expression. data HsPragE p = HsPragSCC (XSCC p) @@ -790,7 +810,7 @@ See also #13680, which requested [] @Int to work. ----------------------- pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc -pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4)) +pprExternalSrcLoc (StringLiteral _ src _,(n1,n2),(n3,n4)) = ppr (src,(n1,n2),(n3,n4)) {- @@ -897,7 +917,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdLet (XCmdLet id) - (LHsLocalBinds id) -- let(rec) + (HsLocalBinds id) -- let(rec) (LHsCmd id) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet', -- 'GHC.Parser.Annotation.AnnOpen' @'{'@, @@ -1057,8 +1077,8 @@ isInfixMatch match = case m_ctxt match of data GRHSs p body = GRHSs { grhssExt :: XCGRHSs p body, - grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs - grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause + grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs + grhssLocalBinds :: HsLocalBinds p -- ^ The where clause } | XGRHSs !(XXGRHSs p body) @@ -1175,7 +1195,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@, -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR) + | LetStmt (XLetStmt idL idR body) (HsLocalBindsLR idL idR) -- ParStmts only occur in a list/monad comprehension | ParStmt (XParStmt idL idR body) -- Post typecheck, @@ -1215,7 +1235,8 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecStmt { recS_ext :: XRecStmt idL idR body - , recS_stmts :: [LStmtLR idL idR body] + , recS_stmts :: XRec idR [LStmtLR idL idR body] + -- Assume XRec is the same for idL and idR, pick one arbitrarily -- The next two fields are only valid after renaming , recS_later_ids :: [IdP idR] @@ -1562,7 +1583,8 @@ data HsBracket p | DecBrL (XDecBrL p) [LHsDecl p] -- [d| decls |]; result of parser | DecBrG (XDecBrG p) (HsGroup p) -- [d| decls |]; result of renamer | TypBr (XTypBr p) (LHsType p) -- [t| type |] - | VarBr (XVarBr p) Bool (IdP p) -- True: 'x, False: ''T + | VarBr (XVarBr p) Bool (LIdP p) + -- True: 'x, False: ''T -- (The Bool flag is used only in pprHsBracket) | TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||] | XBracket !(XXBracket p) -- Note [Trees that Grow] extension point |