Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
246183c6
Commit
246183c6
authored
May 05, 2011
by
Edward Z. Yang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Improve dead block calculation, per Simon Marlow's advice.
Signed-off-by:
Edward Z. Yang
<
ezyang@mit.edu
>
parent
51fd4a1d
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
20 additions
and
21 deletions
+20
-21
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmOpt.hs
+20
-21
No files found.
compiler/cmm/CmmOpt.hs
View file @
246183c6
...
...
@@ -37,6 +37,7 @@ import Data.Bits
import
Data.Word
import
Data.Int
import
Data.Maybe
import
Data.List
import
Compiler.Hoopl
hiding
(
Unique
)
...
...
@@ -57,11 +58,9 @@ cmmEliminateDeadBlocks :: [CmmBasicBlock] -> [CmmBasicBlock]
cmmEliminateDeadBlocks
[]
=
[]
cmmEliminateDeadBlocks
blocks
@
(
BasicBlock
base_id
_
:
_
)
=
let
-- Calculate what's reachable from what block
-- We have to do a deep fold into CmmExpr because
-- there may be a BlockId in the CmmBlock literal.
reachableMap
=
foldl
f
emptyBlockMap
blocks
where
f
m
(
BasicBlock
block_id
stmts
)
=
mapInsert
block_id
(
reachableFrom
stmts
)
m
reachableFrom
stmts
=
foldl
stmt
emptyBlockSet
stmts
reachableMap
=
foldl'
f
emptyUFM
blocks
-- lazy in values
where
f
m
(
BasicBlock
block_id
stmts
)
=
addToUFM
m
block_id
(
reachableFrom
stmts
)
reachableFrom
stmts
=
foldl
stmt
[]
stmts
where
stmt
m
CmmNop
=
m
stmt
m
(
CmmComment
_
)
=
m
...
...
@@ -70,30 +69,30 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
stmt
m
(
CmmCall
c
_
as
_
_
)
=
f
(
actuals
m
as
)
c
where
f
m
(
CmmCallee
e
_
)
=
expr
m
e
f
m
(
CmmPrim
_
)
=
m
stmt
m
(
CmmBranch
b
)
=
setInsert
b
m
stmt
m
(
CmmCondBranch
e
b
)
=
setInsert
b
(
expr
m
e
)
stmt
m
(
CmmSwitch
e
bs
)
=
foldl
(
flip
setInsert
)
(
expr
m
e
)
(
catMaybes
bs
)
stmt
m
(
CmmBranch
b
)
=
b
:
m
stmt
m
(
CmmCondBranch
e
b
)
=
b
:
(
expr
m
e
)
stmt
m
(
CmmSwitch
e
bs
)
=
catMaybes
bs
++
expr
m
e
stmt
m
(
CmmJump
e
as
)
=
expr
(
actuals
m
as
)
e
stmt
m
(
CmmReturn
as
)
=
actuals
m
as
actuals
m
as
=
foldl
(
\
m
h
->
expr
m
(
hintlessCmm
h
))
m
as
actuals
m
as
=
foldl'
(
\
m
h
->
expr
m
(
hintlessCmm
h
))
m
as
-- We have to do a deep fold into CmmExpr because
-- there may be a BlockId in the CmmBlock literal.
expr
m
(
CmmLit
l
)
=
lit
m
l
expr
m
(
CmmLoad
e
_
)
=
expr
m
e
expr
m
(
CmmReg
_
)
=
m
expr
m
(
CmmMachOp
_
es
)
=
foldl
expr
m
es
expr
m
(
CmmMachOp
_
es
)
=
foldl
'
expr
m
es
expr
m
(
CmmStackSlot
_
_
)
=
m
expr
m
(
CmmRegOff
_
_
)
=
m
lit
m
(
CmmBlock
b
)
=
setInsert
b
m
lit
m
(
CmmBlock
b
)
=
b
:
m
lit
m
_
=
m
-- Expand reachable set until you hit fixpoint
initReachable
=
setSingleton
base_id
::
BlockSet
expandReachable
old_set
new_set
=
if
setSize
new_set
>
setSize
old_set
then
expandReachable
new_set
$
setFold
(
\
x
s
->
maybe
setEmpty
id
(
mapLookup
x
reachableMap
)
`
setUnion
`
s
)
new_set
(
setDifference
new_set
old_set
)
else
new_set
-- fixpoint achieved
reachable
=
expandReachable
setEmpty
initReachable
-- go todo done
reachable
=
go
[
base_id
]
(
setEmpty
::
BlockSet
)
where
go
[]
m
=
m
go
(
x
:
xs
)
m
|
setMember
x
m
=
go
xs
m
|
otherwise
=
go
(
add
++
xs
)
(
setInsert
x
m
)
where
add
=
fromMaybe
(
panic
"cmmEliminateDeadBlocks: unknown block"
)
(
lookupUFM
reachableMap
x
)
in
filter
(
\
(
BasicBlock
block_id
_
)
->
setMember
block_id
reachable
)
blocks
-- -----------------------------------------------------------------------------
...
...
Write
Preview
Markdown
is supported
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