Commit 60ed2a65 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Improve specialisation for imported functions

At a SPECIALSE pragma for an imported Id, we used to check that
it was marked INLINABLE.  But that turns out to interact badly with
worker/wrapper: see Note [Worker-wrapper for INLINABLE functions] in

So this small patch instead simply tests that we have an unfolding
for the function; see Note [SPECIALISE pragmas for imported Ids]
in GHC.Tc.Gen.Sig.

Fixes #19246
parent a4c53e3b
......@@ -41,6 +41,7 @@ import GHC.Tc.Utils.Unify( tcSkolemise, unifyType )
import GHC.Tc.Utils.Instantiate( topInstantiate, tcInstTypeBndrs )
import GHC.Tc.Utils.Env( tcLookupId )
import GHC.Tc.Types.Evidence( HsWrapper, (<.>) )
import GHC.Core( hasSomeUnfolding )
import GHC.Core.Type ( mkTyVarBinders )
import GHC.Core.Multiplicity
......@@ -48,7 +49,8 @@ import GHC.Driver.Session
import GHC.Driver.Backend
import GHC.Driver.Ppr
import GHC.Types.Var ( TyVar, Specificity(..), tyVarKind, binderVars )
import GHC.Types.Id ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId )
import GHC.Types.Id ( Id, idName, idType, setInlinePragma
, mkLocalId, realIdUnfolding )
import GHC.Builtin.Names( mkUnboundName )
import GHC.Types.Basic
import GHC.Unit.Module( getModule )
......@@ -807,20 +809,36 @@ tcImpPrags prags
tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
tcImpSpec (name, prag)
= do { id <- tcLookupId name
; if isAnyInlinePragma (idInlinePragma id)
; if hasSomeUnfolding (realIdUnfolding id)
-- See Note [SPECIALISE pragmas for imported Ids]
then tcSpecPrag id prag
else do { addWarnTc NoReason (impSpecErr name)
; return [] } }
-- If there is no INLINE/INLINABLE pragma there will be no unfolding. In
-- that case, just delete the SPECIALISE pragma altogether, lest the
-- desugarer fall over because it can't find the unfolding. See #18118.
impSpecErr :: Name -> SDoc
impSpecErr name
= hang (text "You cannot SPECIALISE" <+> quotes (ppr name))
2 (vcat [ text "because its definition has no INLINE/INLINABLE pragma"
, parens $ sep
[ text "or its defining module" <+> quotes (ppr mod)
, text "was compiled without -O"]])
2 (vcat [ text "because its definition is not visible in this module"
, text "Hint: make sure" <+> ppr mod <+> text "is compiled with -O"
, text " and that" <+> quotes (ppr name)
<+> text "has an INLINABLE pragma" ])
mod = nameModule name
{- Note [SPECIALISE pragmas for imported Ids]
An imported Id may or may not have an unfolding. If not, we obviously
can't specialise it here; indeed the desugar falls over (#18118).
We used to test whether it had a user-specified INLINABLE pragma but,
because of Note [Worker-wrapper for INLINABLE functions] in
GHC.Core.Opt.WorkWrap, even an INLINABLE function may end up with
a wrapper that has no pragma, just an unfolding (#19246). So now
we just test whether the function has an unfolding.
There's a risk that a pragma-free function may have an unfolding now
(because it is fairly small), and then gets a bit bigger, and no
longer has an unfolding in the future. But then you'll get a helpful
error message suggesting an INLINABLE pragma, which you can follow.
That seems enough for now.
module T19246 where
import T19246a
{-# SPECIALISE f :: [Int] -> ([Int], Int) #-}
==================== Tidy Core rules ====================
==================== Tidy Core rules ====================
"SPEC f" [2] forall ($dOrd :: Ord Int). f @Int $dOrd = $sf
"SPEC/T19246 $wf @Int" [2]
forall (w :: Ord Int). $wf @Int w = $s$wf
module T19246a where
f :: Ord a => [a] -> ([a], a)
{-# INLINABLE f #-}
f xs = (ys, maximum ys)
ys = reverse . reverse . reverse . reverse . reverse . reverse $ xs
......@@ -345,3 +345,4 @@ test('T18815', only_ways(['optasm']), makefile_test, ['T18815'])
test('T18668', normal, compile, ['-dsuppress-uniques'])
test('T18995', [ grep_errmsg(r'print') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T19168', normal, compile, [''])
test('T19246', only_ways(['optasm']), multimod_compile, ['T19246', '-v0 -ddump-rules'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment