Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
675c5478
Commit
675c5478
authored
May 05, 2014
by
Simon Peyton Jones
Browse files
Improve comments and tracing in SpecConstr
parent
cdca7915
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/specialise/SpecConstr.lhs
View file @
675c5478
...
...
@@ -396,16 +396,19 @@ use the calls in the un-specialised RHS as seeds. We call these
Note [Top-level recursive groups]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If all the bindings in a top-level recursive group are
not exported,
all the calls are in the rest of the top-level
bindings.
This means we can specialise with those call patterns
instead of with the RHSs
of the recursive group.
If all the bindings in a top-level recursive group are
local (not
exported), then
all the calls are in the rest of the top-level
bindings.
This means we can specialise with those call patterns
instead of with the RHSs
of the recursive group.
To get the call usage information, we work backwards through the top-level bindings
so we see the usage before we get to the binding of the function.
Before we can collect the usage though, we go through all the bindings and add them
to the environment. This is necessary because usage is only tracked for functions
in the environment.
(Question: maybe we should *also* use calls in the rest of the
top-level bindings as seeds?
To get the call usage information, we work backwards through the
top-level bindings so we see the usage before we get to the binding of
the function. Before we can collect the usage though, we go through
all the bindings and add them to the environment. This is necessary
because usage is only tracked for functions in the environment.
The actual seeding of the specialisation is very similar to Note [Local recursive group].
...
...
@@ -1323,16 +1326,14 @@ scTopBind env usage (Rec prs)
= do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss
; return (usage `combineUsage` (combineUsages rhs_usgs), Rec (bndrs `zip` rhss')) }
| otherwise -- Do specialisation
= do { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env)
(bndrs `zip` rhss)
= do { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env)
prs
-- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls usage)) bndrs)) (return ())
-- Note [Top-level recursive groups]
; let (usg,rest) = if all (not . isExportedId) bndrs
then -- pprTrace "scTopBind-T" (ppr bndrs $$ ppr (map (fmap (map snd) . lookupVarEnv (scu_calls usage)) bndrs))
( usage
, [SI [] 0 (Just us) | us <- rhs_usgs] )
else ( combineUsages rhs_usgs
, [SI [] 0 Nothing | _ <- rhs_usgs] )
; let (usg,rest) | any isExportedId bndrs -- Seed from RHSs
= ( combineUsages rhs_usgs, [SI [] 0 Nothing | _ <- rhs_usgs] )
| otherwise -- Seed from body only
= ( usage, [SI [] 0 (Just us) | us <- rhs_usgs] )
; (usage', specs) <- specLoop (scForce env force_spec)
(scu_calls usg) rhs_infos nullUsage rest
...
...
@@ -1446,11 +1447,6 @@ specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
, notNull arg_bndrs -- Only specialise functions
, Just all_calls <- lookupVarEnv bind_calls fn
= do { (boring_call, pats) <- callsToPats env specs arg_occs all_calls
-- ; pprTrace "specialise" (vcat [ ppr fn <+> text "with" <+> int (length pats) <+> text "good patterns"
-- , text "arg_occs" <+> ppr arg_occs
-- , text "calls" <+> ppr all_calls
-- , text "good pats" <+> ppr pats]) $
-- return ()
-- Bale out if too many specialisations
; let n_pats = length pats
...
...
@@ -1473,12 +1469,25 @@ specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
_normal_case -> do {
let spec_env = decreaseSpecCount env n_pats
-- ; if (not (null pats) || isJust mb_unspec) then
-- pprTrace "specialise" (vcat [ ppr fn <+> text "with" <+> int (length pats) <+> text "good patterns"
-- , text "mb_unspec" <+> ppr (isJust mb_unspec)
-- , text "arg_occs" <+> ppr arg_occs
-- , text "good pats" <+> ppr pats]) $
-- return ()
-- else return ()
; let spec_env = decreaseSpecCount env n_pats
; (spec_usgs, new_specs) <- mapAndUnzipM (spec_one spec_env fn arg_bndrs body)
(pats `zip` [spec_count..])
-- See Note [Specialise original body]
; let spec_usg = combineUsages spec_usgs
-- If there were any boring calls among the seeds (= all_calls), then those
-- calls will call the un-specialised function. So we should use the seeds
-- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning
-- then in new_usg.
(new_usg, mb_unspec')
= case mb_unspec of
Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing)
...
...
Administrator
@root
mentioned in commit
fcece347
·
Dec 17, 2018
mentioned in commit
fcece347
mentioned in commit fcece34760929d79dea3e9871462cb927f60aa5c
Toggle commit list
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