Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
7af33e9a
Commit
7af33e9a
authored
Aug 29, 2014
by
Simon Peyton Jones
Browse files
Better specImport discarding message (again)
parent
3521c507
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/specialise/Specialise.lhs
View file @
7af33e9a
...
...
@@ -643,8 +643,8 @@ specImport dflags this_mod done rb fn calls_for_fn
| null calls_for_fn -- We filtered out all the calls in deleteCallsMentioning
= return ([], [])
| wantSpecImport dflags
fn
, Just rhs <- maybeUnfoldingTemplate
(realIdU
nfolding
fn)
| wantSpecImport dflags
unfolding
, Just rhs <- maybeUnfoldingTemplate
u
nfolding
= do { -- Get rules from the external package state
-- We keep doing this in case we "page-fault in"
-- more rules as we go along
...
...
@@ -669,21 +669,25 @@ specImport dflags this_mod done rb fn calls_for_fn
; return (rules2 ++ rules1, spec_binds2 ++ spec_binds1) }
| otherwise
= WARN( True, hang (ptext (sLit "specImport discarding:"))
2 (vcat (map (pprCallInfo fn) calls_for_fn)) )
= WARN( True, hang (ptext (sLit "specImport discarding:") <+> ppr fn <+> dcolon <+> ppr (idType fn))
2 ( (text "want:" <+> ppr (wantSpecImport dflags unfolding))
$$ (text "stable:" <+> ppr (isStableUnfolding unfolding))
$$ (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) ) )
return ([], [])
where
unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers
wantSpecImport :: DynFlags ->
Id
-> Bool
wantSpecImport :: DynFlags ->
Unfolding
-> Bool
-- See Note [Specialise imported INLINABLE things]
wantSpecImport dflags f
n
= case
idUnfolding fn
of
wantSpecImport dflags
un
f
= case
unf
of
NoUnfolding -> False
OtherCon {} -> False
DFunUnfolding {} -> True
CoreUnfolding { uf_src = src, uf_guidance = _guidance }
| gopt Opt_SpecialiseAggressively dflags -> True
| isStableSource src -> True
-- Specialise even IN
I
LNE things; it hasn't inlined yet,
-- Specialise even INL
I
NE things; it hasn't inlined yet,
-- so perhaps it never will. Moreover it may have calls
-- inside it that we want to specialise
| otherwise -> False -- Stable, not INLINE, hence INLINEABLE
...
...
@@ -1614,8 +1618,8 @@ instance Outputable CallInfoSet where
pprCallInfo :: Id -> CallInfo -> SDoc
pprCallInfo fn (CallKey mb_tys, (dxs, _))
= hang (ppr fn
<+> dcolon <+> ppr (idType fn))
2 (
ptext (sLit "args:") <+>
fsep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs))
= hang (ppr fn
)
2 (fsep (map ppr_call_key_ty mb_tys ++ map pprParendExpr dxs))
ppr_call_key_ty :: Maybe Type -> SDoc
ppr_call_key_ty Nothing = char '_'
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment