diff options
| author | Alina Banerjee <alina@glitchgirl.us> | 2021-08-05 08:08:31 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-11 18:15:05 -0400 |
| commit | 100ffe75f509a73f1b26e768237888646f522b6c (patch) | |
| tree | 56702bfdf582572a41b1bfbe9b066039023c0f95 /compiler/GHC/ThToHs.hs | |
| parent | f5fdace5613914724eb00bcf7547c82f3ad12686 (diff) | |
| download | haskell-100ffe75f509a73f1b26e768237888646f522b6c.tar.gz | |
Modify InlineSpec data constructor (helps fix #18138)
The inl_inline field of the InlinePragma record is modified to store pragma
source text by adding a data constructor of type SourceText. This can help in
tracking the actual text of pragma names.
Add/modify functions, modify type instance for InlineSpec type
Modify parser, lexer to handle InlineSpec constructors containing SourceText
Modify functions with InlineSpec type
Extract pragma source from InlineSpec for SpecSig, InlineSig types
Modify cvtInline function to add SourceText to InlineSpec type
Extract name for InlineSig, SpecSig from pragma, SpectInstSig from source (fixes #18138)
Extract pragma name for SpecPrag pragma, SpecSig signature
Add Haddock annotation for inlinePragmaName function
Add Haddock annotations for using helper functions in hsSigDoc
Remove redundant ppr in pragma name for SpecSig, InlineSig; update comment
Rename test to T18138 for misplaced SPECIALIZE pragma testcase
Diffstat (limited to 'compiler/GHC/ThToHs.hs')
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 0f9bb35cd6..96a27a528c 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -778,11 +778,13 @@ cvtPragmaD (InlineP nm inline rm phases) ; let src TH.NoInline = "{-# NOINLINE" src TH.Inline = "{-# INLINE" src TH.Inlinable = "{-# INLINABLE" - ; let ip = InlinePragma { inl_src = SourceText $ src inline - , inl_inline = cvtInline inline + ; let ip = InlinePragma { inl_src = toSrcTxt inline + , inl_inline = cvtInline inline (toSrcTxt inline) , inl_rule = cvtRuleMatch rm , inl_act = cvtPhases phases dflt , inl_sat = Nothing } + where + toSrcTxt a = SourceText $ src a ; returnJustLA $ Hs.SigD noExtField $ InlineSig noAnn nm' ip } cvtPragmaD (SpecialiseP nm ty inline phases) @@ -791,12 +793,14 @@ cvtPragmaD (SpecialiseP nm ty inline phases) ; let src TH.NoInline = "{-# SPECIALISE NOINLINE" src TH.Inline = "{-# SPECIALISE INLINE" src TH.Inlinable = "{-# SPECIALISE INLINE" - ; let (inline', dflt,srcText) = case inline of - Just inline1 -> (cvtInline inline1, dfltActivation inline1, - src inline1) + ; let (inline', dflt, srcText) = case inline of + Just inline1 -> (cvtInline inline1 (toSrcTxt inline1), dfltActivation inline1, + toSrcTxt inline1) Nothing -> (NoUserInlinePrag, AlwaysActive, - "{-# SPECIALISE") - ; let ip = InlinePragma { inl_src = SourceText srcText + SourceText "{-# SPECIALISE") + where + toSrcTxt a = SourceText $ src a + ; let ip = InlinePragma { inl_src = srcText , inl_inline = inline' , inl_rule = Hs.FunLike , inl_act = cvtPhases phases dflt @@ -857,10 +861,10 @@ dfltActivation :: TH.Inline -> Activation dfltActivation TH.NoInline = NeverActive dfltActivation _ = AlwaysActive -cvtInline :: TH.Inline -> Hs.InlineSpec -cvtInline TH.NoInline = Hs.NoInline -cvtInline TH.Inline = Hs.Inline -cvtInline TH.Inlinable = Hs.Inlinable +cvtInline :: TH.Inline -> SourceText -> Hs.InlineSpec +cvtInline TH.NoInline srcText = Hs.NoInline srcText +cvtInline TH.Inline srcText = Hs.Inline srcText +cvtInline TH.Inlinable srcText = Hs.Inlinable srcText cvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo cvtRuleMatch TH.ConLike = Hs.ConLike |