ghc/compiler/nativeGen/AbsCStixGen.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \begin{code}
   6 #include "HsVersions.h"
   7
   8 module AbsCStixGen (
   9         genCodeAbstractC,
  10
  11         -- and, of course, that's not enough...
  12         AbstractC, Target, StixTree, SplitUniqSupply, SUniqSM(..)
  13     ) where
  14
  15 import AbsCSyn
  16 import AbsPrel          ( PrimOp(..), primOpNeedsWrapper, isCompareOp
  17                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  18                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  19                         )
  20 import CgCompInfo       ( mIN_UPD_SIZE )
  21 import ClosureInfo      ( infoTableLabelFromCI, entryLabelFromCI, fastLabelFromCI,
  22                           closureUpdReqd
  23                         )
  24 import MachDesc
  25 import Maybes           ( Maybe(..), maybeToBool )
  26 import Outputable
  27 import PrimKind         ( isFloatingKind )
  28 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  29 import Stix
  30 import StixInfo         ( genCodeInfoTable )
  31 import SplitUniq
  32 import Unique
  33 import Util
  34 \end{code}
  35
  36 For each independent chunk of AbstractC code, we generate a list of @StixTree@s,
  37 where each tree corresponds to a single Stix instruction.  We leave the chunks
  38 separated so that register allocation can be performed locally within the chunk.
  39
  40 \begin{code}
  41 -- hacking with Uncle Will:
  42 #define target_STRICT target@(Target _ _ _ _ _ _ _ _)
  43
  44 genCodeAbstractC
  45     :: Target
  46     -> AbstractC
  47     -> SUniqSM [[StixTree]]
  48
  49 genCodeAbstractC target_STRICT absC =
  50     mapSUs gentopcode (mkAbsCStmtList absC) `thenSUs` \ trees ->
  51     returnSUs ([StComment SLIT("Native Code")] : trees)
  52  where
  53  -- "target" munging things... ---
  54  a2stix  = amodeToStix  target
  55  a2stix' = amodeToStix' target
  56  volsaves    = volatileSaves target
  57  volrestores = volatileRestores target
  58  p2stix      = primToStix target
  59  macro_code  = macroCode target
  60  hp_rel      = hpRel target
  61  -- real code follows... ---------
  62 \end{code}
  63
  64 Here we handle top-level things, like @CCodeBlock@s and
  65 @CClosureInfoTable@s.
  66
  67 \begin{code}
  68  {-
  69  genCodeTopAbsC
  70     :: Target
  71     -> AbstractC
  72     -> SUniqSM [StixTree]
  73  -}
  74
  75  gentopcode (CCodeBlock label absC) =
  76     gencode absC                                `thenSUs` \ code ->
  77     returnSUs (StSegment TextSegment : StFunBegin label : code [StFunEnd label])
  78
  79  gentopcode stmt@(CStaticClosure label _ _ _) =
  80     genCodeStaticClosure stmt                   `thenSUs` \ code ->
  81     returnSUs (StSegment DataSegment : StLabel label : code [])
  82
  83  gentopcode stmt@(CRetUnVector _ _) = returnSUs []
  84
  85  gentopcode stmt@(CFlatRetVector label _) =
  86     genCodeVecTbl stmt                          `thenSUs` \ code ->
  87     returnSUs (StSegment TextSegment : code [StLabel label])
  88
  89  gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _ _ _)
  90
  91   | slow_is_empty
  92   = genCodeInfoTable hp_rel a2stix stmt         `thenSUs` \ itbl ->
  93     returnSUs (StSegment TextSegment : itbl [])
  94
  95   | otherwise
  96   = genCodeInfoTable hp_rel a2stix stmt         `thenSUs` \ itbl ->
  97     gencode slow                                `thenSUs` \ slow_code ->
  98     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
  99               slow_code [StFunEnd slow_lbl]))
 100   where
 101     slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
 102     slow_lbl = entryLabelFromCI cl_info
 103
 104  gentopcode stmt@(CClosureInfoAndCode cl_info slow (Just fast) _ _ _) =
 105  -- ToDo: what if this is empty? ------------------------^^^^
 106     genCodeInfoTable hp_rel a2stix stmt         `thenSUs` \ itbl ->
 107     gencode slow                                `thenSUs` \ slow_code ->
 108     gencode fast                                `thenSUs` \ fast_code ->
 109     returnSUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
 110               slow_code (StFunEnd slow_lbl : StFunBegin fast_lbl :
 111               fast_code [StFunEnd fast_lbl])))
 112   where
 113     slow_lbl = entryLabelFromCI cl_info
 114     fast_lbl = fastLabelFromCI cl_info
 115
 116  gentopcode absC =
 117     gencode absC                                `thenSUs` \ code ->
 118     returnSUs (StSegment TextSegment : code [])
 119
 120 \end{code}
 121
 122 Vector tables are trivial!
 123
 124 \begin{code}
 125  {-
 126  genCodeVecTbl
 127     :: Target
 128     -> AbstractC
 129     -> SUniqSM StixTreeList
 130  -}
 131  genCodeVecTbl (CFlatRetVector label amodes) =
 132     returnSUs (\xs -> vectbl : xs)
 133   where
 134     vectbl = StData PtrKind (reverse (map a2stix amodes))
 135
 136 \end{code}
 137
 138 Static closures are not so hard either.
 139
 140 \begin{code}
 141  {-
 142  genCodeStaticClosure
 143     :: Target
 144     -> AbstractC
 145     -> SUniqSM StixTreeList
 146  -}
 147  genCodeStaticClosure (CStaticClosure _ cl_info cost_centre amodes) =
 148     returnSUs (\xs -> table : xs)
 149   where
 150     table = StData PtrKind (StCLbl info_lbl : body)
 151     info_lbl = infoTableLabelFromCI cl_info
 152
 153     body = if closureUpdReqd cl_info then
 154                 take (max mIN_UPD_SIZE (length amodes')) (amodes' ++ zeros)
 155            else
 156                 amodes'
 157
 158     zeros = StInt 0 : zeros
 159
 160     amodes' = map amodeZeroVoid amodes
 161
 162         -- Watch out for VoidKinds...cf. PprAbsC
 163     amodeZeroVoid item
 164       | getAmodeKind item == VoidKind = StInt 0
 165       | otherwise = a2stix item
 166
 167 \end{code}
 168
 169 Now the individual AbstractC statements.
 170
 171 \begin{code}
 172  {-
 173  gencode
 174     :: Target
 175     -> AbstractC
 176     -> SUniqSM StixTreeList
 177  -}
 178 \end{code}
 179
 180 @AbsCNop@s just disappear.
 181
 182 \begin{code}
 183
 184  gencode AbsCNop = returnSUs id
 185
 186 \end{code}
 187
 188 OLD:@CComment@s are passed through as the corresponding @StComment@s.
 189
 190 \begin{code}
 191
 192  --UNUSED:gencode (CComment s) = returnSUs (\xs -> StComment s : xs)
 193
 194 \end{code}
 195
 196 Split markers are a NOP in this land.
 197
 198 \begin{code}
 199
 200  gencode CSplitMarker = returnSUs id
 201
 202 \end{code}
 203
 204 AbstractC instruction sequences are handled individually, and the
 205 resulting StixTreeLists are joined together.
 206
 207 \begin{code}
 208
 209  gencode (AbsCStmts c1 c2) =
 210     gencode c1                          `thenSUs` \ b1 ->
 211     gencode c2                          `thenSUs` \ b2 ->
 212     returnSUs (b1 . b2)
 213
 214 \end{code}
 215
 216 Initialising closure headers in the heap...a fairly complex ordeal if
 217 done properly.  For now, we just set the info pointer, but we should
 218 really take a peek at the flags to determine whether or not there are
 219 other things to be done (setting cost centres, age headers, global
 220 addresses, etc.)
 221
 222 \begin{code}
 223
 224  gencode (CInitHdr cl_info reg_rel _ _) =
 225     let
 226         lhs = a2stix (CVal reg_rel PtrKind)
 227         lbl = infoTableLabelFromCI cl_info
 228     in
 229         returnSUs (\xs -> StAssign PtrKind lhs (StCLbl lbl) : xs)
 230
 231 \end{code}
 232
 233 Assignment, the curse of von Neumann, is the center of the code we
 234 produce.  In most cases, the type of the assignment is determined
 235 by the type of the destination.  However, when the destination can
 236 have mixed types, the type of the assignment is ``StgWord'' (we use
 237 PtrKind for lack of anything better).  Think:  do we also want a cast
 238 of the source?  Be careful about floats/doubles.
 239
 240 \begin{code}
 241
 242  gencode (CAssign lhs rhs)
 243   | getAmodeKind lhs == VoidKind = returnSUs id
 244   | otherwise =
 245     let pk = getAmodeKind lhs
 246         pk' = if mixedTypeLocn lhs && not (isFloatingKind pk) then IntKind else pk
 247         lhs' = a2stix lhs
 248         rhs' = a2stix' rhs
 249     in
 250         returnSUs (\xs -> StAssign pk' lhs' rhs' : xs)
 251
 252 \end{code}
 253
 254 Unconditional jumps, including the special ``enter closure'' operation.
 255 Note that the new entry convention requires that we load the InfoPtr (R2)
 256 with the address of the info table before jumping to the entry code for Node.
 257
 258 \begin{code}
 259
 260  gencode (CJump dest) =
 261     returnSUs (\xs -> StJump (a2stix dest) : xs)
 262
 263  gencode (CFallThrough (CLbl lbl _)) =
 264     returnSUs (\xs -> StFallThrough lbl : xs)
 265
 266  gencode (CReturn dest DirectReturn) =
 267     returnSUs (\xs -> StJump (a2stix dest) : xs)
 268
 269  gencode (CReturn table (StaticVectoredReturn n)) =
 270     returnSUs (\xs -> StJump dest : xs)
 271   where
 272     dest = StInd PtrKind (StIndex PtrKind (a2stix table)
 273                                           (StInt (toInteger (-n-1))))
 274
 275  gencode (CReturn table (DynamicVectoredReturn am)) =
 276     returnSUs (\xs -> StJump dest : xs)
 277   where
 278     dest = StInd PtrKind (StIndex PtrKind (a2stix table) dyn_off)
 279     dyn_off = StPrim IntSubOp [StPrim IntNegOp [a2stix am], StInt 1]
 280
 281 \end{code}
 282
 283 Now the PrimOps, some of which may need caller-saves register wrappers.
 284
 285 \begin{code}
 286
 287  gencode (COpStmt results op args liveness_mask vols)
 288   -- ToDo (ADR?): use that liveness mask
 289   | primOpNeedsWrapper op =
 290     let
 291         saves = volsaves vols
 292         restores = volrestores vols
 293     in
 294         p2stix (nonVoid results) op (nonVoid args)
 295                                                         `thenSUs` \ code ->
 296         returnSUs (\xs -> saves ++ code (restores ++ xs))
 297
 298   | otherwise = p2stix (nonVoid results) op (nonVoid args)
 299     where
 300         nonVoid = filter ((/= VoidKind) . getAmodeKind)
 301
 302 \end{code}
 303
 304 Now the dreaded conditional jump.
 305
 306 Now the if statement.  Almost *all* flow of control are of this form.
 307 @
 308         if (am==lit) { absC } else { absCdef }
 309 @
 310         =>
 311 @
 312         IF am = lit GOTO l1:
 313         absC
 314         jump l2:
 315    l1:
 316         absCdef
 317    l2:
 318 @
 319
 320 \begin{code}
 321
 322  gencode (CSwitch discrim alts deflt)
 323   = case alts of
 324       [] -> gencode deflt
 325
 326       [(tag,alt_code)] -> case maybe_empty_deflt of
 327                                 Nothing -> gencode alt_code
 328                                 Just dc -> mkIfThenElse discrim tag alt_code dc
 329
 330       [(tag1@(MachInt i1 _), alt_code1),
 331        (tag2@(MachInt i2 _), alt_code2)]
 332         | deflt_is_empty && i1 == 0 && i2 == 1
 333         -> mkIfThenElse discrim tag1 alt_code1 alt_code2
 334         | deflt_is_empty && i1 == 1 && i2 == 0
 335         -> mkIfThenElse discrim tag2 alt_code2 alt_code1
 336
 337         -- If the @discrim@ is simple, then this unfolding is safe.
 338       other | simple_discrim -> mkSimpleSwitches discrim alts deflt
 339
 340         -- Otherwise, we need to do a bit of work.
 341       other ->  getSUnique                        `thenSUs` \ u ->
 342                 gencode (AbsCStmts
 343                 (CAssign (CTemp u pk) discrim)
 344                 (CSwitch (CTemp u pk) alts deflt))
 345
 346   where
 347     maybe_empty_deflt = nonemptyAbsC deflt
 348     deflt_is_empty = case maybe_empty_deflt of
 349                         Nothing -> True
 350                         Just _  -> False
 351
 352     pk = getAmodeKind discrim
 353
 354     simple_discrim = case discrim of
 355                         CReg _    -> True
 356                         CTemp _ _ -> True
 357                         other     -> False
 358 \end{code}
 359
 360
 361
 362 Finally, all of the disgusting AbstractC macros.
 363
 364 \begin{code}
 365
 366  gencode (CMacroStmt macro args) = macro_code macro args
 367
 368  gencode (CCallProfCtrMacro macro _) =
 369     returnSUs (\xs -> StComment macro : xs)
 370
 371  gencode (CCallProfCCMacro macro _) =
 372     returnSUs (\xs -> StComment macro : xs)
 373
 374 \end{code}
 375
 376 Here, we generate a jump table if there are more than four (integer) alternatives and
 377 the jump table occupancy is greater than 50%.  Otherwise, we generate a binary
 378 comparison tree.  (Perhaps this could be tuned.)
 379
 380 \begin{code}
 381
 382  intTag :: BasicLit -> Integer
 383  intTag (MachChar c) = toInteger (ord c)
 384  intTag (MachInt i _) = i
 385  intTag _ = panic "intTag"
 386
 387  fltTag :: BasicLit -> Rational
 388
 389  fltTag (MachFloat f) = f
 390  fltTag (MachDouble d) = d
 391  fltTag _ = panic "fltTag"
 392
 393  {-
 394  mkSimpleSwitches
 395     :: Target
 396     -> CAddrMode -> [(BasicLit,AbstractC)] -> AbstractC
 397     -> SUniqSM StixTreeList
 398  -}
 399  mkSimpleSwitches am alts absC =
 400     getUniqLabelNCG                                     `thenSUs` \ udlbl ->
 401     getUniqLabelNCG                                     `thenSUs` \ ujlbl ->
 402     let am' = a2stix am
 403         joinedAlts = map (\ (tag,code) -> (tag, mkJoin code ujlbl)) alts
 404         sortedAlts = naturalMergeSortLe leAlt joinedAlts
 405                      -- naturalMergeSortLe, because we often get sorted alts to begin with
 406
 407         lowTag = intTag (fst (head sortedAlts))
 408         highTag = intTag (fst (last sortedAlts))
 409
 410         -- lowest and highest possible values the discriminant could take
 411         lowest = if floating then targetMinDouble else targetMinInt
 412         highest = if floating then targetMaxDouble else targetMaxInt
 413
 414         -- These should come from somewhere else, depending on the target arch
 415         -- (Note that the floating point values aren't terribly important.)
 416         -- ToDo: Fix!(JSM)
 417         targetMinDouble = MachDouble (-1.7976931348623157e+308)
 418         targetMaxDouble = MachDouble (1.7976931348623157e+308)
 419         targetMinInt = mkMachInt (-2147483647)
 420         targetMaxInt = mkMachInt 2147483647
 421     in
 422         (
 423         if not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then
 424             mkJumpTable am' sortedAlts lowTag highTag udlbl
 425         else
 426             mkBinaryTree am' floating sortedAlts choices lowest highest udlbl
 427         )
 428                                                         `thenSUs` \ alt_code ->
 429         gencode absC                            `thenSUs` \ dflt_code ->
 430
 431         returnSUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
 432
 433     where
 434         floating = isFloatingKind (getAmodeKind am)
 435         choices = length alts
 436
 437         (x@(MachChar _),_)  `leAlt` (y,_) = intTag x <= intTag y
 438         (x@(MachInt _ _),_) `leAlt` (y,_) = intTag x <= intTag y
 439         (x,_)               `leAlt` (y,_) = fltTag x <= fltTag y
 440
 441 \end{code}
 442
 443 We use jump tables when doing an integer switch on a relatively dense list of
 444 alternatives.  We expect to be given a list of alternatives, sorted by tag,
 445 and a range of values for which we are to generate a table.  Of course, the tags of
 446 the alternatives should lie within the indicated range.  The alternatives need
 447 not cover the range; a default target is provided for the missing alternatives.
 448
 449 If a join is necessary after the switch, the alternatives should already finish
 450 with a jump to the join point.
 451
 452 \begin{code}
 453  {-
 454  mkJumpTable
 455     :: Target
 456     -> StixTree                 -- discriminant
 457     -> [(BasicLit, AbstractC)]  -- alternatives
 458     -> Integer                  -- low tag
 459     -> Integer                  -- high tag
 460     -> CLabel                   -- default label
 461     -> SUniqSM StixTreeList
 462  -}
 463
 464  mkJumpTable am alts lowTag highTag dflt =
 465     getUniqLabelNCG                                     `thenSUs` \ utlbl ->
 466     mapSUs genLabel alts                                `thenSUs` \ branches ->
 467     let cjmpLo = StCondJump dflt (StPrim IntLtOp [am, StInt lowTag])
 468         cjmpHi = StCondJump dflt (StPrim IntGtOp [am, StInt highTag])
 469
 470         offset = StPrim IntSubOp [am, StInt lowTag]
 471         jump = StJump (StInd PtrKind (StIndex PtrKind (StCLbl utlbl) offset))
 472
 473         tlbl = StLabel utlbl
 474         table = StData PtrKind (mkTable branches [lowTag..highTag] [])
 475     in
 476         mapSUs mkBranch branches                        `thenSUs` \ alts ->
 477
 478         returnSUs (\xs -> cjmpLo : cjmpHi : jump :
 479                          StSegment DataSegment : tlbl : table :
 480                          StSegment TextSegment : foldr1 (.) alts xs)
 481
 482     where
 483         genLabel x = getUniqLabelNCG `thenSUs` \ lbl -> returnSUs (lbl, x)
 484
 485         mkBranch (lbl,(_,alt)) =
 486             gencode alt                         `thenSUs` \ alt_code ->
 487             returnSUs (\xs -> StLabel lbl : alt_code xs)
 488
 489         mkTable _  []     tbl = reverse tbl
 490         mkTable [] (x:xs) tbl = mkTable [] xs (StCLbl dflt : tbl)
 491         mkTable alts@((lbl,(tag,_)):rest) (x:xs) tbl
 492           | intTag tag == x = mkTable rest xs (StCLbl lbl : tbl)
 493           | otherwise = mkTable alts xs (StCLbl dflt : tbl)
 494
 495 \end{code}
 496
 497 We generate binary comparison trees when a jump table is inappropriate.
 498 We expect to be given a list of alternatives, sorted by tag, and for
 499 convenience, the length of the alternative list.  We recursively break
 500 the list in half and do a comparison on the first tag of the second half
 501 of the list.  (Odd lists are broken so that the second half of the list
 502 is longer.)  We can handle either integer or floating kind alternatives,
 503 so long as they are not mixed.  (We assume that the type of the discriminant
 504 determines the type of the alternatives.)
 505
 506 As with the jump table approach, if a join is necessary after the switch, the
 507 alternatives should already finish with a jump to the join point.
 508
 509 \begin{code}
 510  {-
 511  mkBinaryTree
 512     :: Target
 513     -> StixTree                 -- discriminant
 514     -> Bool                     -- floating point?
 515     -> [(BasicLit, AbstractC)]  -- alternatives
 516     -> Int                      -- number of choices
 517     -> BasicLit                 -- low tag
 518     -> BasicLit                 -- high tag
 519     -> CLabel                   -- default code label
 520     -> SUniqSM StixTreeList
 521  -}
 522
 523  mkBinaryTree am floating [(tag,alt)] _ lowTag highTag udlbl
 524   | rangeOfOne = gencode alt
 525   | otherwise =
 526     let tag' = a2stix (CLit tag)
 527         cmpOp = if floating then DoubleNeOp else IntNeOp
 528         test = StPrim cmpOp [am, tag']
 529         cjmp = StCondJump udlbl test
 530     in
 531         gencode alt                             `thenSUs` \ alt_code ->
 532         returnSUs (\xs -> cjmp : alt_code xs)
 533
 534     where
 535         rangeOfOne = not floating && intTag lowTag + 1 >= intTag highTag
 536         -- When there is only one possible tag left in range, we skip the comparison
 537
 538  mkBinaryTree am floating alts choices lowTag highTag udlbl =
 539     getUniqLabelNCG                                     `thenSUs` \ uhlbl ->
 540     let tag' = a2stix (CLit splitTag)
 541         cmpOp = if floating then DoubleGeOp else IntGeOp
 542         test = StPrim cmpOp [am, tag']
 543         cjmp = StCondJump uhlbl test
 544     in
 545         mkBinaryTree am floating alts_lo half lowTag splitTag udlbl
 546                                                         `thenSUs` \ lo_code ->
 547         mkBinaryTree am floating alts_hi (choices - half) splitTag highTag udlbl
 548                                                         `thenSUs` \ hi_code ->
 549
 550         returnSUs (\xs -> cjmp : lo_code (StLabel uhlbl : hi_code xs))
 551
 552     where
 553         half = choices `div` 2
 554         (alts_lo, alts_hi) = splitAt half alts
 555         splitTag = fst (head alts_hi)
 556
 557 \end{code}
 558
 559 \begin{code}
 560  {-
 561  mkIfThenElse
 562     :: Target
 563     -> CAddrMode            -- discriminant
 564     -> BasicLit             -- tag
 565     -> AbstractC            -- if-part
 566     -> AbstractC            -- else-part
 567     -> SUniqSM StixTreeList
 568  -}
 569
 570  mkIfThenElse discrim tag alt deflt =
 571     getUniqLabelNCG                                     `thenSUs` \ ujlbl ->
 572     getUniqLabelNCG                                     `thenSUs` \ utlbl ->
 573     let discrim' = a2stix discrim
 574         tag' = a2stix (CLit tag)
 575         cmpOp = if (isFloatingKind (getAmodeKind discrim)) then DoubleNeOp else IntNeOp
 576         test = StPrim cmpOp [discrim', tag']
 577         cjmp = StCondJump utlbl test
 578         dest = StLabel utlbl
 579         join = StLabel ujlbl
 580     in
 581         gencode (mkJoin alt ujlbl)              `thenSUs` \ alt_code ->
 582         gencode deflt                           `thenSUs` \ dflt_code ->
 583         returnSUs (\xs -> cjmp : alt_code (dest : dflt_code (join : xs)))
 584
 585 mkJoin :: AbstractC -> CLabel -> AbstractC
 586
 587 mkJoin code lbl
 588   | mightFallThrough code = mkAbsCStmts code (CJump (CLbl lbl PtrKind))
 589   | otherwise = code
 590 \end{code}
 591
 592 %---------------------------------------------------------------------------
 593
 594 This answers the question: Can the code fall through to the next
 595 line(s) of code?  This errs towards saying True if it can't choose,
 596 because it is used for eliminating needless jumps.  In other words, if
 597 you might possibly {\em not} jump, then say yes to falling through.
 598
 599 \begin{code}
 600 mightFallThrough :: AbstractC -> Bool
 601
 602 mightFallThrough absC = ft absC True
 603  where
 604   ft AbsCNop       if_empty = if_empty
 605
 606   ft (CJump _)       if_empty = False
 607   ft (CReturn _ _)   if_empty = False
 608   ft (CSwitch _ alts deflt) if_empty
 609         = ft deflt if_empty ||
 610           or [ft alt if_empty | (_,alt) <- alts]
 611
 612   ft (AbsCStmts c1 c2) if_empty = ft c2 (ft c1 if_empty)
 613   ft _ if_empty = if_empty
 614
 615 {- Old algorithm, which called nonemptyAbsC for every subexpression! =========
 616 fallThroughAbsC (AbsCStmts c1 c2) =
 617     case nonemptyAbsC c2 of
 618         Nothing -> fallThroughAbsC c1
 619         Just x -> fallThroughAbsC x
 620 fallThroughAbsC (CJump _)        = False
 621 fallThroughAbsC (CReturn _ _)    = False
 622 fallThroughAbsC (CSwitch _ choices deflt)
 623   = (not (isEmptyAbsC deflt) && fallThroughAbsC deflt)
 624     || or (map (fallThroughAbsC . snd) choices)
 625 fallThroughAbsC other            = True
 626
 627 isEmptyAbsC :: AbstractC -> Bool
 628 isEmptyAbsC = not . maybeToBool . nonemptyAbsC
 629 ================= End of old, quadratic, algorithm -}
 630 \end{code}