summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore
diff options
context:
space:
mode:
authorAlina Banerjee <alina@glitchgirl.us>2021-08-05 08:08:31 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-08-11 18:15:05 -0400
commit100ffe75f509a73f1b26e768237888646f522b6c (patch)
tree56702bfdf582572a41b1bfbe9b066039023c0f95 /compiler/GHC/HsToCore
parentf5fdace5613914724eb00bcf7547c82f3ad12686 (diff)
downloadhaskell-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/HsToCore')
-rw-r--r--compiler/GHC/HsToCore/Binds.hs11
-rw-r--r--compiler/GHC/HsToCore/Quote.hs8
2 files changed, 9 insertions, 10 deletions
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 01a8d1d9a5..602de4070a 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -397,10 +397,9 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
| otherwise
= case inlinePragmaSpec inline_prag of
NoUserInlinePrag -> (gbl_id, rhs)
- NoInline -> (gbl_id, rhs)
- Inlinable -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
- Inline -> inline_pair
-
+ NoInline {} -> (gbl_id, rhs)
+ Inlinable {} -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
+ Inline {} -> inline_pair
where
simpl_opts = initSimpleOpts dflags
inline_prag = idInlinePragma gbl_id
@@ -768,8 +767,8 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
-- no_act_spec is True if the user didn't write an explicit
-- phase specification in the SPECIALISE pragma
no_act_spec = case inlinePragmaSpec spec_inl of
- NoInline -> isNeverActive spec_prag_act
- _ -> isAlwaysActive spec_prag_act
+ NoInline _ -> isNeverActive spec_prag_act
+ _ -> isAlwaysActive spec_prag_act
rule_act | no_act_spec = inlinePragmaActivation id_inl -- Inherit
| otherwise = spec_prag_act -- Specified by user
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index ec7cb058ca..ea185b076f 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1118,10 +1118,10 @@ rep_specialiseInst ty loc
; return [(loc, pragma)] }
repInline :: InlineSpec -> MetaM (Core TH.Inline)
-repInline NoInline = dataCon noInlineDataConName
-repInline Inline = dataCon inlineDataConName
-repInline Inlinable = dataCon inlinableDataConName
-repInline NoUserInlinePrag = notHandled ThNoUserInline
+repInline (NoInline _ ) = dataCon noInlineDataConName
+repInline (Inline _ ) = dataCon inlineDataConName
+repInline (Inlinable _ ) = dataCon inlinableDataConName
+repInline NoUserInlinePrag = notHandled ThNoUserInline
repRuleMatch :: RuleMatchInfo -> MetaM (Core TH.RuleMatch)
repRuleMatch ConLike = dataCon conLikeDataConName