Commit 557d889d authored by simonmar's avatar simonmar

[project @ 2004-08-20 12:21:03 by simonmar]

Simplify the "impossible branch" handling, and fix a bug in the
process.  CmmSwitch encodes the possibility of having impossible
branches (the destinations are Maybe BlockId rather than just BlockId)
so we don't need to encode impossible branches as dummy blocks
containing a jump to an impossible location (currently 0).

However, PprC and PprCmm weren't set up to cope with Nothings in a
CmmSwitch, so this commit fixes that too.
parent fa93dff5
...@@ -40,7 +40,7 @@ import Constants ...@@ -40,7 +40,7 @@ import Constants
import CmdLineOpts ( opt_EnsureSplittableC ) import CmdLineOpts ( opt_EnsureSplittableC )
-- The rest -- The rest
import Data.List ( intersperse, group ) import Data.List ( intersperse, groupBy )
import Data.Bits ( shiftR ) import Data.Bits ( shiftR )
import Char ( ord, chr ) import Char ( ord, chr )
import IO ( Handle ) import IO ( Handle )
...@@ -251,29 +251,26 @@ pprCondBranch expr ident ...@@ -251,29 +251,26 @@ pprCondBranch expr ident
-- --
pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
pprSwitch e maybe_ids pprSwitch e maybe_ids
= let ids = [ i | Just i <- maybe_ids ] = let pairs = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
pairs = zip [ 0 .. ] (concatMap markfalls (group ids)) pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
in in
(hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace) (hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
4 (vcat ( map caseify pairs ))) 4 (vcat ( map caseify pairs2 )))
$$ rbrace $$ rbrace
where where
-- fall through case sndEq (_,x) (_,y) = x == y
caseify (i,Left ident) =
hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
ptext SLIT("/* fall through for"),
pprBlockId ident,
ptext SLIT("*/") ]
caseify (i,Right ident) =
hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-- mark the bottom of a fallthough sequence of cases as `Right'
markfalls [a] = [Right a]
markfalls as = map (\a -> Left a) (init as) ++ [Right (last as)]
-- fall through case
caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
where
do_fallthrough ix =
hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
ptext SLIT("/* fall through */") ]
final_branch ix =
hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Expressions. -- Expressions.
......
...@@ -219,18 +219,13 @@ genJump expr actuals = ...@@ -219,18 +219,13 @@ genJump expr actuals =
-- --
-- switch [0 .. n] (expr) { case ... ; } -- switch [0 .. n] (expr) { case ... ; }
-- --
-- N.B. we remove 'Nothing's from the list of branches, as they don't
-- seem to make sense currently. This may change, if they are defined in
-- some way.
--
genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
genSwitch expr maybe_ids genSwitch expr maybe_ids
= let ids = [ i | Just i <- maybe_ids ] = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
pairs = groupBy snds (zip [0 .. ] ids )
in hang (hcat [ ptext SLIT("switch [0 .. ") in hang (hcat [ ptext SLIT("switch [0 .. ")
, int (length ids - 1) , int (length maybe_ids - 1)
, ptext SLIT("] ") , ptext SLIT("] ")
, if isTrivialCmmExpr expr , if isTrivialCmmExpr expr
then pprExpr expr then pprExpr expr
...@@ -242,13 +237,16 @@ genSwitch expr maybe_ids ...@@ -242,13 +237,16 @@ genSwitch expr maybe_ids
where where
snds a b = (snd a) == (snd b) snds a b = (snd a) == (snd b)
caseify :: [(Int,BlockId)] -> SDoc caseify :: [(Int,Maybe BlockId)] -> SDoc
caseify ixs@((i,Nothing):_)
= ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
<> ptext SLIT(" */")
caseify as caseify as
= let (is,ids) = unzip as = let (is,ids) = unzip as
in hsep [ ptext SLIT("case") in hsep [ ptext SLIT("case")
, hcat (punctuate comma (map int is)) , hcat (punctuate comma (map int is))
, ptext SLIT(": goto") , ptext SLIT(": goto")
, pprBlockId (head ids) <> semi ] , pprBlockId (head [ id | Just id <- ids]) <> semi ]
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Expressions -- Expressions
......
...@@ -394,16 +394,14 @@ mk_switch tag_expr [(tag,stmts)] (Just deflt) lo_tag hi_tag ...@@ -394,16 +394,14 @@ mk_switch tag_expr [(tag,stmts)] (Just deflt) lo_tag hi_tag
-- DENSE TAG RANGE: use a switch statment -- DENSE TAG RANGE: use a switch statment
mk_switch tag_expr branches mb_deflt lo_tag hi_tag mk_switch tag_expr branches mb_deflt lo_tag hi_tag
| use_switch -- Use a switch | use_switch -- Use a switch
= do { deflt_id <- get_deflt_id mb_deflt = do { branch_ids <- mapM forkCgStmts (map snd branches)
; branch_ids <- mapM forkCgStmts (map snd branches)
; let ; let
tagged_blk_ids = zip (map fst branches) branch_ids tagged_blk_ids = zip (map fst branches) (map Just branch_ids)
find_branch :: BlockId -> ConTagZ -> BlockId find_branch :: ConTagZ -> Maybe BlockId
find_branch deflt_id i = assocDefault deflt_id tagged_blk_ids i find_branch i = assocDefault mb_deflt tagged_blk_ids i
arms = [ Just (find_branch deflt_id (i+lo_tag)) arms = [ find_branch (i+lo_tag) | i <- [0..n_tags-1]]
| i <- [0..n_tags-1]]
switch_stmt = CmmSwitch (cmmOffset tag_expr (- lo_tag)) arms switch_stmt = CmmSwitch (cmmOffset tag_expr (- lo_tag)) arms
...@@ -443,19 +441,6 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag ...@@ -443,19 +441,6 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag
(lo_branches, hi_branches) = span is_lo branches (lo_branches, hi_branches) = span is_lo branches
is_lo (t,_) = t < mid_tag is_lo (t,_) = t < mid_tag
-- Add a default block if the case is not exhaustive
get_deflt_id (Just deflt_id) = return deflt_id
get_deflt_id Nothing
| exhaustive
= return (pprPanic "mk_deflt_blks" (ppr tag_expr))
| otherwise
= do { stmts <- getCgStmts (stmtC jump_to_impossible)
; id <- forkCgStmts stmts
; return id }
jump_to_impossible
= CmmJump (mkLblExpr mkErrorStdEntryLabel) []
assignTemp' e assignTemp' e
| isTrivialCmmExpr e = return (CmmNop, e) | isTrivialCmmExpr e = return (CmmNop, e)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment