Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
b55b1f59
Commit
b55b1f59
authored
Aug 24, 2001
by
simonpj
Browse files
[project @ 2001-08-24 12:45:28 by simonpj]
Fix an obscure but easy bug in SpecConstr
parent
de3d7644
Changes
1
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/specialise/SpecConstr.lhs
View file @
b55b1f59
...
...
@@ -35,6 +35,7 @@ import Util ( mapAccumL )
import List ( nubBy, partition )
import UniqSupply
import Outputable
import UniqFM ( ufmToList )
\end{code}
-----------------------------------------------------
...
...
@@ -222,6 +223,11 @@ data HowBound = RecFun -- These are the recursive functions for which
-- passed as a parameter and what is in scope at the
-- function definition site
instance Outputable HowBound where
ppr RecFun = text "RecFun"
ppr RecArg = text "RecArg"
ppr Other = text "Other"
lookupScopeEnv env v = lookupVarEnv (scope env) v
extendBndrs env bndrs = env { scope = extendVarEnvList (scope env) [(b,Other) | b <- bndrs] }
...
...
@@ -370,18 +376,20 @@ scExpr env e@(App _ _)
scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
scBind env (Rec [(fn,rhs)])
| not (null val_bndrs)
= scExpr env
'
body
`thenUs` \ (usg, body') ->
= scExpr env
_fn_body
body `thenUs` \ (usg, body') ->
let
SCU { calls = calls, occs = occs } = usg
in
specialise env fn bndrs body usg `thenUs` \ (rules, spec_prs) ->
returnUs (extendBndrs env bndrs,
returnUs (extendBndr env fn, -- For the body of the letrec, just
-- extend the env with Other to record
-- that it's in scope; no funny RecFun business
SCU { calls = calls `delVarEnv` fn, occs = occs `delVarEnvList` val_bndrs},
Rec ((fn `addIdSpecialisations` rules, mkLams bndrs body') : spec_prs))
where
(bndrs,body) = collectBinders rhs
val_bndrs = filter isId bndrs
env
'
= extendRecBndr env fn bndrs
env
_fn_body
= extendRecBndr env fn bndrs
scBind env (Rec prs)
= mapAndUnzipUs do_one prs `thenUs` \ (usgs, prs') ->
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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