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