summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r--compiler/GHC/Parser/Lexer.x2
-rw-r--r--compiler/GHC/Parser/PostProcess.hs15
2 files changed, 17 insertions, 0 deletions
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 02717c7dae..b1d8f43350 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -761,6 +761,7 @@ data Token
-- Pragmas, see Note [Pragma source text] in "GHC.Types.Basic"
| ITinline_prag SourceText InlineSpec RuleMatchInfo
+ | ITopaque_prag SourceText
| ITspec_prag SourceText -- SPECIALISE
| ITspec_inline_prag SourceText Bool -- SPECIALISE INLINE (or NOINLINE)
| ITsource_prag SourceText
@@ -3446,6 +3447,7 @@ oneWordPrags = Map.fromList [
-- Spelling variant
("notinline",
strtoken (\s -> (ITinline_prag (SourceText s) (NoInline (SourceText s)) FunLike))),
+ ("opaque", strtoken (\s -> ITopaque_prag (SourceText s))),
("specialize", strtoken (\s -> ITspec_prag (SourceText s))),
("source", strtoken (\s -> ITsource_prag (SourceText s))),
("warning", strtoken (\s -> ITwarning_prag (SourceText s))),
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 444471abca..e6daea8fe8 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -30,6 +30,7 @@ module GHC.Parser.PostProcess (
mkTyFamInst,
mkFamDecl,
mkInlinePragma,
+ mkOpaquePragma,
mkPatSynMatchGroup,
mkRecConstrOrUpdate,
mkTyClD, mkInstD,
@@ -2559,8 +2560,22 @@ mkInlinePragma src (inl, match_info) mb_act
Nothing -> -- No phase specified
case inl of
NoInline _ -> NeverActive
+ Opaque _ -> NeverActive
_other -> AlwaysActive
+mkOpaquePragma :: SourceText -> InlinePragma
+mkOpaquePragma src
+ = InlinePragma { inl_src = src
+ , inl_inline = Opaque src
+ , inl_sat = Nothing
+ -- By marking the OPAQUE pragma NeverActive we stop
+ -- (constructor) specialisation on OPAQUE things.
+ --
+ -- See Note [OPAQUE pragma]
+ , inl_act = NeverActive
+ , inl_rule = FunLike
+ }
+
-----------------------------------------------------------------------------
-- utilities for foreign declarations