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
import CmdLineOpts ( opt_EnsureSplittableC )
-- The rest
import Data.List ( intersperse, group )
import Data.List ( intersperse, groupBy )
import Data.Bits ( shiftR )
import Char ( ord, chr )
import IO ( Handle )
......@@ -251,29 +251,26 @@ pprCondBranch expr ident
--
pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
pprSwitch e maybe_ids
= let ids = [ i | Just i <- maybe_ids ]
pairs = zip [ 0 .. ] (concatMap markfalls (group ids))
= let pairs = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
in
(hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
4 (vcat ( map caseify pairs )))
4 (vcat ( map caseify pairs2 )))
$$ rbrace
where
-- fall through case
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)]
sndEq (_,x) (_,y) = x == y
-- 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.
......
......@@ -219,18 +219,13 @@ genJump expr actuals =
--
-- 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 expr maybe_ids
= let ids = [ i | Just i <- maybe_ids ]
pairs = groupBy snds (zip [0 .. ] ids )
= let pairs = groupBy snds (zip [0 .. ] maybe_ids )
in hang (hcat [ ptext SLIT("switch [0 .. ")
, int (length ids - 1)
, int (length maybe_ids - 1)
, ptext SLIT("] ")
, if isTrivialCmmExpr expr
then pprExpr expr
......@@ -242,13 +237,16 @@ genSwitch expr maybe_ids
where
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
= let (is,ids) = unzip as
in hsep [ ptext SLIT("case")
, hcat (punctuate comma (map int is))
, ptext SLIT(": goto")
, pprBlockId (head ids) <> semi ]
, pprBlockId (head [ id | Just id <- ids]) <> semi ]
-- --------------------------------------------------------------------------
-- Expressions
......
......@@ -394,16 +394,14 @@ mk_switch tag_expr [(tag,stmts)] (Just deflt) lo_tag hi_tag
-- DENSE TAG RANGE: use a switch statment
mk_switch tag_expr branches mb_deflt lo_tag hi_tag
| use_switch -- Use a switch
= do { deflt_id <- get_deflt_id mb_deflt
; branch_ids <- mapM forkCgStmts (map snd branches)
= do { branch_ids <- mapM forkCgStmts (map snd branches)
; 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 deflt_id i = assocDefault deflt_id tagged_blk_ids i
find_branch :: ConTagZ -> Maybe BlockId
find_branch i = assocDefault mb_deflt tagged_blk_ids i
arms = [ Just (find_branch deflt_id (i+lo_tag))
| i <- [0..n_tags-1]]
arms = [ find_branch (i+lo_tag) | i <- [0..n_tags-1]]
switch_stmt = CmmSwitch (cmmOffset tag_expr (- lo_tag)) arms
......@@ -443,19 +441,6 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag
(lo_branches, hi_branches) = span is_lo branches
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
| 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