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
c105c749
Commit
c105c749
authored
Sep 11, 2007
by
nr@eecs.harvard.edu
Browse files
scrape some unused barnacles off of ZipCfg and put them into ZipCfgExtras
parent
c0a5a5d2
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/ZipCfg.hs
View file @
c105c749
...
...
@@ -9,22 +9,30 @@ module ZipCfg
,
LastNode
,
mkBranchNode
,
isBranchNode
,
branchNodeTarget
-- Observers and transformers
,
entry
,
exit
,
focus
,
focusp
,
unfocus
,
blockId
,
zip
,
unzip
,
last
,
goto_end
,
ht_to_first
,
ht_to_last
,
zipht
,
tailOfLast
,
splice_head
,
splice_tail
,
splice_head_only
,
splice_focus_entry
,
splice_focus_exit
,
remove_entry_label
,
blockId
,
zip
,
unzip
,
last
,
goto_end
,
zipht
,
tailOfLast
,
remove_entry_label
,
splice_tail
,
splice_head
,
splice_head_only
,
of_block_list
,
to_block_list
,
map_nodes
,
postorder_dfs
,
fold_layout
,
fold_blocks
,
fold_
fwd_
block
,
foldM_fwd_block
,
map_nodes
,
translate
,
fold_layout
,
fold_block
s
,
translate
,
pprLgraph
{-
-- the following functions might one day be useful and can be found
-- either below or in ZipCfgExtras:
, entry, exit, focus, focusp, unfocus
, ht_to_first, ht_to_last,
, splice_focus_entry, splice_focus_exit
, fold_fwd_block, foldM_fwd_block
-}
)
where
import
Maybes
import
Outputable
hiding
(
empty
)
import
Panic
import
Prelude
hiding
(
zip
,
unzip
,
last
)
...
...
@@ -111,21 +119,6 @@ fourth representation that is asymptotically optimal for such construction.
-}
entry
::
LGraph
m
l
->
FGraph
m
l
-- focus on edge out of entry node
exit
::
LGraph
m
l
->
FGraph
m
l
-- focus on edge into default exit node
-- (fails if there isn't one)
focus
::
BlockId
->
LGraph
m
l
->
FGraph
m
l
-- focus on edge out of node with id
focusp
::
(
Block
m
l
->
Bool
)
->
LGraph
m
l
->
Maybe
(
FGraph
m
l
)
-- focus on start of block satisfying predicate
unfocus
::
FGraph
m
l
->
LGraph
m
l
-- lose focus
-- | We can insert a single-entry, single-exit subgraph at
-- the current focus.
-- The new focus can be at either the entry edge or the exit edge.
splice_focus_entry
::
FGraph
m
l
->
LGraph
m
l
->
FGraph
m
l
splice_focus_exit
::
FGraph
m
l
->
LGraph
m
l
->
FGraph
m
l
--------------- Representation --------------------
-- | A basic block is a [[first]] node, followed by zero or more [[middle]]
...
...
@@ -269,18 +262,6 @@ instance LastNode l => HavingSuccessors (Block m l) where
succs
b
=
succs
(
unzip
b
)
------------------- Observing nodes
-- | Fold from first to last
fold_fwd_block
::
(
BlockId
->
a
->
a
)
->
(
m
->
a
->
a
)
->
(
ZLast
l
->
a
->
a
)
->
Block
m
l
->
a
->
a
-- | iterate from first to last
foldM_fwd_block
::
Monad
m
=>
(
BlockId
->
a
->
m
a
)
->
(
mid
->
a
->
m
a
)
->
(
ZLast
l
->
a
->
m
a
)
->
Block
mid
l
->
a
->
m
a
-- ================ IMPLEMENTATION ================--
blockId
(
Block
id
_
)
=
id
...
...
@@ -313,14 +294,12 @@ last (ZBlock _ t) = lastt t
where
lastt
(
ZLast
l
)
=
l
lastt
(
ZTail
_
t
)
=
lastt
t
focus
::
BlockId
->
LGraph
m
l
->
FGraph
m
l
-- focus on edge out of node with id
focus
id
(
LGraph
entry
blocks
)
=
case
lookupBlockEnv
blocks
id
of
Just
b
->
FGraph
entry
(
unzip
b
)
(
delFromUFM
blocks
id
)
Nothing
->
panic
"asked for nonexistent block in flow graph"
focusp
p
(
LGraph
entry
blocks
)
=
fmap
(
\
(
b
,
bs
)
->
FGraph
entry
(
unzip
b
)
bs
)
(
splitp_blocks
p
blocks
)
splitp_blocks
::
(
Block
m
l
->
Bool
)
->
BlockEnv
(
Block
m
l
)
->
Maybe
(
Block
m
l
,
BlockEnv
(
Block
m
l
))
splitp_blocks
p
blocks
=
lift
$
foldUFM
scan
(
Nothing
,
emptyBlockEnv
)
blocks
...
...
@@ -332,12 +311,6 @@ splitp_blocks p blocks = lift $ foldUFM scan (Nothing, emptyBlockEnv) blocks
lift
(
Nothing
,
_
)
=
Nothing
lift
(
Just
b
,
bs
)
=
Just
(
b
,
bs
)
entry
g
@
(
LGraph
eid
_
)
=
focus
eid
g
exit
g
@
(
LGraph
eid
_
)
=
FGraph
eid
(
ZBlock
h
(
ZLast
l
))
others
where
FGraph
_
b
others
=
focusp
is_exit
g
`
orElse
`
panic
"no exit in flow graph"
(
h
,
l
)
=
goto_end
b
is_exit
::
Block
m
l
->
Bool
is_exit
b
=
case
last
(
unzip
b
)
of
{
LastExit
->
True
;
_
->
False
}
...
...
@@ -350,8 +323,6 @@ insertBlock b bs =
Just
_
->
panic
(
"duplicate labels "
++
show
id
++
" in ZipCfg graph"
)
where
id
=
blockId
b
unfocus
(
FGraph
e
bz
bs
)
=
LGraph
e
(
insertBlock
(
zip
bz
)
bs
)
check_single_exit
::
LGraph
l
m
->
a
->
a
check_single_exit
g
=
let
check
block
found
=
case
last
(
unzip
block
)
of
...
...
@@ -366,6 +337,11 @@ check_single_exit g =
freshBlockId
::
String
->
UniqSM
BlockId
freshBlockId
_
=
do
{
u
<-
getUniqueUs
;
return
$
BlockId
u
}
entry
::
LGraph
m
l
->
FGraph
m
l
-- focus on edge out of entry node
entry
g
@
(
LGraph
eid
_
)
=
focus
eid
g
postorder_dfs
g
@
(
LGraph
_
blocks
)
=
let
FGraph
_
eblock
_
=
entry
g
in
vnode
(
zip
eblock
)
(
\
acc
_visited
->
acc
)
[]
emptyBlockSet
...
...
@@ -395,14 +371,6 @@ fold_layout f z g@(LGraph eid _) = fold (postorder_dfs g) z
if
id
==
eid
then
panic
"entry as successor"
else
Just
id
fold_fwd_block
first
middle
last
(
Block
id
t
)
z
=
tail
t
(
first
id
z
)
where
tail
(
ZTail
m
t
)
z
=
tail
t
(
middle
m
z
)
tail
(
ZLast
l
)
z
=
last
l
z
foldM_fwd_block
first
middle
last
(
Block
id
t
)
z
=
do
{
z
<-
first
id
z
;
tail
t
z
}
where
tail
(
ZTail
m
t
)
z
=
do
{
z
<-
middle
m
z
;
tail
t
z
}
tail
(
ZLast
l
)
z
=
last
l
z
fold_blocks
f
z
(
LGraph
_
blocks
)
=
foldUFM
f
z
blocks
map_nodes
idm
middle
last
(
LGraph
eid
blocks
)
=
LGraph
(
idm
eid
)
(
mapUFM
block
blocks
)
...
...
@@ -465,14 +433,6 @@ splice_tail g tail =
(
entry
,
LGraph
(
gr_entry
g
)
(
insertBlock
(
zipht
exit
tail
)
others
))
in
prepare_for_splicing
g
splice_one_block
splice_many_blocks
splice_focus_entry
(
FGraph
eid
(
ZBlock
head
tail
)
blocks
)
g
=
let
(
tail'
,
g'
)
=
splice_tail
g
tail
in
FGraph
eid
(
ZBlock
head
tail'
)
(
plusUFM
(
gr_blocks
g'
)
blocks
)
splice_focus_exit
(
FGraph
eid
(
ZBlock
head
tail
)
blocks
)
g
=
let
(
g'
,
head'
)
=
splice_head
head
g
in
FGraph
eid
(
ZBlock
head'
tail
)
(
plusUFM
(
gr_blocks
g'
)
blocks
)
splice_head_only
head
g
=
let
FGraph
eid
gentry
gblocks
=
entry
g
in
case
gentry
of
...
...
compiler/cmm/ZipCfgCmmRep.hs
View file @
c105c749
...
...
@@ -157,12 +157,7 @@ instance Outputable Convention where
instance
DF
.
DebugNodes
Middle
Last
instance
Outputable
CmmGraph
where
ppr
=
pprCmmGraphAsRep
pprCmmGraphAsRep
::
CmmGraph
->
SDoc
pprCmmGraphAsRep
g
=
vcat
(
map
ppr_block
blocks
)
where
blocks
=
postorder_dfs
g
ppr_block
(
Block
id
tail
)
=
hang
(
ppr
id
<>
colon
)
4
(
ppr
tail
)
ppr
=
pprLgraph
pprMiddle
::
Middle
->
SDoc
pprMiddle
stmt
=
(
case
stmt
of
...
...
compiler/cmm/ZipCfgExtras.hs
0 → 100644
View file @
c105c749
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-- This module contains code related to the zipcfg representation.
-- The code either has been used or has been thought to be useful
-- within the Quick C-- compiler, but as yet no use has been found for
-- it within GHC. This module should therefore be considered to be
-- full of code that need not be maintained. Should a function in
-- this module prove useful, it should not be exported, but rather
-- should be migrated back into ZipCfg (or possibly ZipCfgUtil), where
-- it can be maintained.
module
ZipCfgExtras
()
where
import
Maybes
import
Panic
import
ZipCfg
import
UniqFM
import
Prelude
hiding
(
zip
,
unzip
,
last
)
exit
::
LGraph
m
l
->
FGraph
m
l
-- focus on edge into default exit node
-- (fails if there isn't one)
focusp
::
(
Block
m
l
->
Bool
)
->
LGraph
m
l
->
Maybe
(
FGraph
m
l
)
-- focus on start of block satisfying predicate
unfocus
::
FGraph
m
l
->
LGraph
m
l
-- lose focus
-- | We can insert a single-entry, single-exit subgraph at
-- the current focus.
-- The new focus can be at either the entry edge or the exit edge.
splice_focus_entry
::
FGraph
m
l
->
LGraph
m
l
->
FGraph
m
l
splice_focus_exit
::
FGraph
m
l
->
LGraph
m
l
->
FGraph
m
l
_unused
::
()
_unused
=
all
`
seq
`
()
where
all
=
(
exit
,
focusp
,
unfocus
,
splice_focus_entry
,
splice_focus_exit
,
fold_fwd_block
,
foldM_fwd_block
(
\
_
a
->
Just
a
)
)
unfocus
(
FGraph
e
bz
bs
)
=
LGraph
e
(
insertBlock
(
zip
bz
)
bs
)
focusp
p
(
LGraph
entry
blocks
)
=
fmap
(
\
(
b
,
bs
)
->
FGraph
entry
(
unzip
b
)
bs
)
(
splitp_blocks
p
blocks
)
exit
g
@
(
LGraph
eid
_
)
=
FGraph
eid
(
ZBlock
h
(
ZLast
l
))
others
where
FGraph
_
b
others
=
focusp
is_exit
g
`
orElse
`
panic
"no exit in flow graph"
(
h
,
l
)
=
goto_end
b
splice_focus_entry
(
FGraph
eid
(
ZBlock
head
tail
)
blocks
)
g
=
let
(
tail'
,
g'
)
=
splice_tail
g
tail
in
FGraph
eid
(
ZBlock
head
tail'
)
(
plusUFM
(
gr_blocks
g'
)
blocks
)
splice_focus_exit
(
FGraph
eid
(
ZBlock
head
tail
)
blocks
)
g
=
let
(
g'
,
head'
)
=
splice_head
head
g
in
FGraph
eid
(
ZBlock
head'
tail
)
(
plusUFM
(
gr_blocks
g'
)
blocks
)
-- | Fold from first to last
fold_fwd_block
::
(
BlockId
->
a
->
a
)
->
(
m
->
a
->
a
)
->
(
ZLast
l
->
a
->
a
)
->
Block
m
l
->
a
->
a
fold_fwd_block
first
middle
last
(
Block
id
t
)
z
=
tail
t
(
first
id
z
)
where
tail
(
ZTail
m
t
)
z
=
tail
t
(
middle
m
z
)
tail
(
ZLast
l
)
z
=
last
l
z
-- | iterate from first to last
foldM_fwd_block
::
Monad
m
=>
(
BlockId
->
a
->
m
a
)
->
(
mid
->
a
->
m
a
)
->
(
ZLast
l
->
a
->
m
a
)
->
Block
mid
l
->
a
->
m
a
foldM_fwd_block
first
middle
last
(
Block
id
t
)
z
=
do
{
z
<-
first
id
z
;
tail
t
z
}
where
tail
(
ZTail
m
t
)
z
=
do
{
z
<-
middle
m
z
;
tail
t
z
}
tail
(
ZLast
l
)
z
=
last
l
z
splitp_blocks
::
(
Block
m
l
->
Bool
)
->
BlockEnv
(
Block
m
l
)
->
Maybe
(
Block
m
l
,
BlockEnv
(
Block
m
l
))
splitp_blocks
=
undefined
-- implemented in ZipCfg but not exported
is_exit
::
Block
m
l
->
Bool
is_exit
=
undefined
-- implemented in ZipCfg but not exported
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