2 % (c) The AQUA Project, Glasgow University, 1993-1998
6 module AbsCStixGen ( genCodeAbstractC ) where
8 #include "HsVersions.h"
10 import Ratio ( Rational )
16 import AbsCUtils ( getAmodeRep, mixedTypeLocn,
17 nonemptyAbsC, mkAbsCStmts
19 import PprAbsC ( dumpRealC )
20 import SMRep ( fixedItblSize,
22 rET_VEC_SMALL, rET_VEC_BIG
24 import Constants ( mIN_UPD_SIZE, wORD_SIZE )
25 import CLabel ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
26 mkClosureTblLabel, mkClosureLabel,
27 labelDynamic, mkSplitMarkerLabel )
28 import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI,
29 fastLabelFromCI, closureUpdReqd,
30 staticClosureNeedsLink
32 import Literal ( Literal(..), word2IntLit )
33 import Maybes ( maybeToBool )
34 import StgSyn ( StgOp(..) )
35 import MachOp ( MachOp(..), resultRepsOfMachOp )
36 import PrimRep ( isFloatingRep, is64BitRep,
37 PrimRep(..), getPrimRepArrayElemSize )
38 import StixInfo ( genCodeInfoTable, genBitmapInfoTable,
39 livenessIsSmall, bitmapToIntegers )
40 import StixMacro ( macroCode, checkCode )
41 import StixPrim ( foreignCallCode, amodeToStix, amodeToStix' )
42 import Outputable ( pprPanic, ppr )
43 import UniqSupply ( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
44 import Util ( naturalMergeSortLe )
45 import Panic ( panic )
46 import TyCon ( tyConDataCons )
47 import DataCon ( dataConWrapId )
48 import Name ( NamedThing(..) )
49 import CmdLineOpts ( opt_Static, opt_EnsureSplittableC )
50 import Outputable ( assertPanic )
53 --import IOExts ( trace )
54 --import Outputable ( showSDoc )
55 --import MachOp ( pprMachOp )
59 For each independent chunk of AbstractC code, we generate a list of
60 @StixTree@s, where each tree corresponds to a single Stix instruction.
61 We leave the chunks separated so that register allocation can be
62 performed locally within the chunk.
65 genCodeAbstractC :: AbstractC -> UniqSM [StixStmt]
71 a2stix' = amodeToStix'
72 volsaves = volatileSaves
73 volrestores = volatileRestores
74 macro_code = macroCode
75 -- real code follows... ---------
78 Here we handle top-level things, like @CCodeBlock@s and
88 gentopcode (CCodeBlock lbl absC)
89 = gencode absC `thenUs` \ code ->
90 returnUs (StSegment TextSegment : StFunBegin lbl : code [StFunEnd lbl])
92 gentopcode stmt@(CStaticClosure lbl _ _ _)
93 = genCodeStaticClosure stmt `thenUs` \ code ->
96 then StSegment DataSegment
97 : StLabel lbl : code []
98 else StSegment DataSegment
99 : StData PtrRep [StInt 0] -- DLLised world, need extra zero word
100 : StLabel lbl : code []
103 gentopcode stmt@(CRetVector lbl _ _ _)
104 = genCodeVecTbl stmt `thenUs` \ code ->
105 returnUs (StSegment TextSegment
106 : code [StLabel lbl, vtbl_post_label_word])
108 -- We put a dummy word after the vtbl label so as to ensure the label
109 -- is in the same (Text) section as the vtbl it labels. This is critical
110 -- for ensuring the GC works correctly, although GC crashes due to
111 -- misclassification are much more likely to show up in the interactive
112 -- system than in compile code. For details see comment near line 1164
113 -- of ghc/driver/mangler/ghc-asm.lprl, which contains an analogous fix for
114 -- the mangled via-C route.
115 vtbl_post_label_word = StData PtrRep [StInt 0]
117 gentopcode stmt@(CRetDirect uniq absC srt liveness)
118 = gencode absC `thenUs` \ code ->
119 genBitmapInfoTable liveness srt closure_type False `thenUs` \ itbl ->
120 returnUs (StSegment TextSegment :
121 itbl (StLabel lbl_info : StLabel lbl_ret : code []))
123 lbl_info = mkReturnInfoLabel uniq
124 lbl_ret = mkReturnPtLabel uniq
125 closure_type = if livenessIsSmall liveness then rET_SMALL else rET_BIG
127 gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _)
130 = genCodeInfoTable stmt `thenUs` \ itbl ->
131 returnUs (StSegment TextSegment : itbl [])
134 = genCodeInfoTable stmt `thenUs` \ itbl ->
135 gencode slow `thenUs` \ slow_code ->
136 returnUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
137 slow_code [StFunEnd slow_lbl]))
139 slow_is_empty = not (maybeToBool (nonemptyAbsC slow))
140 slow_lbl = entryLabelFromCI cl_info
142 gentopcode stmt@(CClosureInfoAndCode cl_info slow (Just fast) _) =
143 -- ToDo: what if this is empty? ------------------------^^^^
144 genCodeInfoTable stmt `thenUs` \ itbl ->
145 gencode slow `thenUs` \ slow_code ->
146 gencode fast `thenUs` \ fast_code ->
147 returnUs (StSegment TextSegment : itbl (StFunBegin slow_lbl :
148 slow_code (StFunEnd slow_lbl : StFunBegin fast_lbl :
149 fast_code [StFunEnd fast_lbl])))
151 slow_lbl = entryLabelFromCI cl_info
152 fast_lbl = fastLabelFromCI cl_info
154 gentopcode stmt@(CSRT lbl closures)
155 = returnUs [ StSegment TextSegment
157 , StData DataPtrRep (map mk_StCLbl_for_SRT closures)
160 mk_StCLbl_for_SRT :: CLabel -> StixExpr
161 mk_StCLbl_for_SRT label
163 = StIndex Int8Rep (StCLbl label) (StInt 1)
167 gentopcode stmt@(CBitmap lbl mask)
168 = returnUs $ case bitmapToIntegers mask of
170 [ StSegment TextSegment
172 , StData WordRep (map StInt (toInteger (length mask') : mask'))
176 gentopcode stmt@(CClosureTbl tycon)
177 = returnUs [ StSegment TextSegment
178 , StLabel (mkClosureTblLabel tycon)
179 , StData DataPtrRep (map (StCLbl . mkClosureLabel . getName . dataConWrapId)
180 (tyConDataCons tycon) )
183 gentopcode stmt@(CModuleInitBlock lbl absC)
184 = gencode absC `thenUs` \ code ->
185 getUniqLabelNCG `thenUs` \ tmp_lbl ->
186 getUniqLabelNCG `thenUs` \ flag_lbl ->
187 returnUs ( StSegment DataSegment
189 : StData IntRep [StInt 0]
190 : StSegment TextSegment
192 : StCondJump tmp_lbl (StMachOp MO_Nat_Ne
193 [StInd IntRep (StCLbl flag_lbl),
195 : StAssignMem IntRep (StCLbl flag_lbl) (StInt 1)
198 , StAssignReg PtrRep stgSp
199 (StIndex PtrRep (StReg stgSp) (StInt (-1)))
200 , StJump NoDestInfo (StInd WordRep (StReg stgSp))
204 = gencode absC `thenUs` \ code ->
205 returnUs (StSegment TextSegment : code [])
212 -> UniqSM StixTreeList
214 genCodeVecTbl (CRetVector lbl amodes srt liveness)
215 = genBitmapInfoTable liveness srt closure_type True `thenUs` \itbl ->
216 returnUs (\xs -> vectbl : itbl xs)
218 vectbl = StData PtrRep (reverse (map a2stix amodes))
219 closure_type = if livenessIsSmall liveness then rET_VEC_SMALL else rET_VEC_BIG
227 -> UniqSM StixTreeList
229 genCodeStaticClosure (CStaticClosure _ cl_info cost_centre amodes)
230 = returnUs (\xs -> table ++ xs)
232 table = StData PtrRep [StCLbl (infoTableLabelFromCI cl_info)] :
233 map do_one_amode amodes ++
234 [StData PtrRep (padding_wds ++ static_link)]
237 = StData (promote_to_word (getAmodeRep amode)) [a2stix amode]
239 -- We need to promote any item smaller than a word to a word
241 | getPrimRepArrayElemSize pk >= getPrimRepArrayElemSize IntRep = pk
244 upd_reqd = closureUpdReqd cl_info
247 | upd_reqd = take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
250 static_link | upd_reqd || staticClosureNeedsLink cl_info = [StInt 0]
253 zeros = StInt 0 : zeros
256 -- Watch out for VoidKinds...cf. PprAbsC
258 | getAmodeRep item == VoidRep = StInt 0
259 | otherwise = a2stix item
264 Now the individual AbstractC statements.
270 -> UniqSM StixTreeList
274 @AbsCNop@s just disappear.
278 gencode AbsCNop = returnUs id
282 Split markers just insert a __stg_split_marker, which is caught by the
283 split-mangler later on and used to split the assembly into chunks.
288 | opt_EnsureSplittableC = returnUs (\xs -> StLabel mkSplitMarkerLabel : xs)
289 | otherwise = returnUs id
293 AbstractC instruction sequences are handled individually, and the
294 resulting StixTreeLists are joined together.
298 gencode (AbsCStmts c1 c2)
299 = gencode c1 `thenUs` \ b1 ->
300 gencode c2 `thenUs` \ b2 ->
303 gencode (CSequential stuff)
307 foo (s:ss) = gencode s `thenUs` \ stix ->
308 foo ss `thenUs` \ stixes ->
309 returnUs (stix . stixes)
313 Initialising closure headers in the heap...a fairly complex ordeal if
314 done properly. For now, we just set the info pointer, but we should
315 really take a peek at the flags to determine whether or not there are
316 other things to be done (setting cost centres, age headers, global
321 gencode (CInitHdr cl_info reg_rel _ _)
324 lbl = infoTableLabelFromCI cl_info
326 returnUs (\xs -> StAssignMem PtrRep lhs (StCLbl lbl) : xs)
334 gencode (CCheck macro args assts)
335 = gencode assts `thenUs` \assts_stix ->
336 checkCode macro args assts_stix
340 Assignment, the curse of von Neumann, is the center of the code we
341 produce. In most cases, the type of the assignment is determined
342 by the type of the destination. However, when the destination can
343 have mixed types, the type of the assignment is ``StgWord'' (we use
344 PtrRep for lack of anything better). Think: do we also want a cast
345 of the source? Be careful about floats/doubles.
349 gencode (CAssign lhs rhs)
353 = let -- This is a Hack. Should be cleaned up.
355 pk' | ncg_target_is_32bit && is64BitRep lhs_rep
358 = if mixedTypeLocn lhs && not (isFloatingRep lhs_rep)
364 returnUs (\xs -> mkStAssign pk' lhs' rhs' : xs)
366 lhs_rep = getAmodeRep lhs
370 Unconditional jumps, including the special ``enter closure'' operation.
371 Note that the new entry convention requires that we load the InfoPtr (R2)
372 with the address of the info table before jumping to the entry code for Node.
374 For a vectored return, we must subtract the size of the info table to
375 get at the return vector. This depends on the size of the info table,
376 which varies depending on whether we're profiling etc.
381 = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs)
383 gencode (CFallThrough (CLbl lbl _))
384 = returnUs (\xs -> StFallThrough lbl : xs)
386 gencode (CReturn dest DirectReturn)
387 = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs)
389 gencode (CReturn table (StaticVectoredReturn n))
390 = returnUs (\xs -> StJump NoDestInfo dest : xs)
392 dest = StInd PtrRep (StIndex PtrRep (a2stix table)
393 (StInt (toInteger (-n-fixedItblSize-1))))
395 gencode (CReturn table (DynamicVectoredReturn am))
396 = returnUs (\xs -> StJump NoDestInfo dest : xs)
398 dest = StInd PtrRep (StIndex PtrRep (a2stix table) dyn_off)
399 dyn_off = StMachOp MO_Nat_Sub [StMachOp MO_NatS_Neg [a2stix am],
400 StInt (toInteger (fixedItblSize+1))]
404 Now the PrimOps, some of which may need caller-saves register wrappers.
407 gencode (COpStmt results (StgFCallOp fcall _) args vols)
408 = ASSERT( null vols )
409 foreignCallCode (nonVoid results) fcall (nonVoid args)
411 gencode (COpStmt results (StgPrimOp op) args vols)
412 = panic "AbsCStixGen.gencode: un-translated PrimOp"
414 -- Translate out array indexing primops right here, so that
415 -- individual targets don't have to deal with them
417 gencode (CMachOpStmt (Just r1) (MO_ReadOSBI off_w rep) [base,index] vols)
422 (StInd rep (StMachOp MO_Nat_Add
423 [StIndex rep (a2stix base) (a2stix index),
424 StInt (toInteger (off_w * wORD_SIZE))]))
428 -- Ordinary MachOps are passed through unchanged.
429 gencode (CMachOpStmt Nothing (MO_WriteOSBI off_w rep) [base,index,val] vols)
434 [StIndex rep (a2stix base) (a2stix index),
435 StInt (toInteger (off_w * wORD_SIZE))])
440 gencode (CMachOpStmt (Just r1) mop args vols)
441 = case resultRepsOfMachOp mop of
444 mkStAssign rep (a2stix r1)
445 (StMachOp mop (map a2stix args))
450 Now the dreaded conditional jump.
452 Now the if statement. Almost *all* flow of control are of this form.
454 if (am==lit) { absC } else { absCdef }
468 gencode (CSwitch discrim alts deflt)
472 [(tag,alt_code)] -> case maybe_empty_deflt of
473 Nothing -> gencode alt_code
474 Just dc -> mkIfThenElse discrim tag alt_code dc
476 [(tag1@(MachInt i1), alt_code1),
477 (tag2@(MachInt i2), alt_code2)]
478 | deflt_is_empty && i1 == 0 && i2 == 1
479 -> mkIfThenElse discrim tag1 alt_code1 alt_code2
480 | deflt_is_empty && i1 == 1 && i2 == 0
481 -> mkIfThenElse discrim tag2 alt_code2 alt_code1
483 -- If the @discrim@ is simple, then this unfolding is safe.
484 other | simple_discrim -> mkSimpleSwitches discrim alts deflt
486 -- Otherwise, we need to do a bit of work.
487 other -> getUniqueUs `thenUs` \ u ->
489 (CAssign (CTemp u pk) discrim)
490 (CSwitch (CTemp u pk) alts deflt))
493 maybe_empty_deflt = nonemptyAbsC deflt
494 deflt_is_empty = case maybe_empty_deflt of
498 pk = getAmodeRep discrim
500 simple_discrim = case discrim of
508 Finally, all of the disgusting AbstractC macros.
512 gencode (CMacroStmt macro args) = macro_code macro args
514 gencode (CCallProfCtrMacro macro _)
515 = returnUs (\xs -> StComment macro : xs)
517 gencode (CCallProfCCMacro macro _)
518 = returnUs (\xs -> StComment macro : xs)
520 gencode CCallTypedef{} = returnUs id
523 = pprPanic "AbsCStixGen.gencode" (dumpRealC other)
525 nonVoid = filter ((/= VoidRep) . getAmodeRep)
528 Here, we generate a jump table if there are more than four (integer)
529 alternatives and the jump table occupancy is greater than 50%.
530 Otherwise, we generate a binary comparison tree. (Perhaps this could
535 intTag :: Literal -> Integer
536 intTag (MachChar c) = toInteger c
537 intTag (MachInt i) = i
538 intTag (MachWord w) = intTag (word2IntLit (MachWord w))
539 intTag _ = panic "intTag"
541 fltTag :: Literal -> Rational
543 fltTag (MachFloat f) = f
544 fltTag (MachDouble d) = d
545 fltTag x = pprPanic "fltTag" (ppr x)
549 :: CAddrMode -> [(Literal,AbstractC)] -> AbstractC
550 -> UniqSM StixTreeList
552 mkSimpleSwitches am alts absC
553 = getUniqLabelNCG `thenUs` \ udlbl ->
554 getUniqLabelNCG `thenUs` \ ujlbl ->
556 joinedAlts = map (\ (tag,code) -> (tag, mkJoin code ujlbl)) alts
557 sortedAlts = naturalMergeSortLe leAlt joinedAlts
558 -- naturalMergeSortLe, because we often get sorted alts to begin with
560 lowTag = intTag (fst (head sortedAlts))
561 highTag = intTag (fst (last sortedAlts))
563 -- lowest and highest possible values the discriminant could take
564 lowest = if floating then targetMinDouble else targetMinInt
565 highest = if floating then targetMaxDouble else targetMaxInt
568 if not floating && choices > 4
569 && highTag - lowTag < toInteger (2 * choices)
571 mkJumpTable am' sortedAlts lowTag highTag udlbl
573 mkBinaryTree am' floating sortedAlts choices lowest highest udlbl
575 `thenUs` \ alt_code ->
576 gencode absC `thenUs` \ dflt_code ->
578 returnUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
581 floating = isFloatingRep (getAmodeRep am)
582 choices = length alts
584 (x@(MachChar _),_) `leAlt` (y,_) = intTag x <= intTag y
585 (x@(MachInt _), _) `leAlt` (y,_) = intTag x <= intTag y
586 (x@(MachWord _), _) `leAlt` (y,_) = intTag x <= intTag y
587 (x,_) `leAlt` (y,_) = fltTag x <= fltTag y
591 We use jump tables when doing an integer switch on a relatively dense
592 list of alternatives. We expect to be given a list of alternatives,
593 sorted by tag, and a range of values for which we are to generate a
594 table. Of course, the tags of the alternatives should lie within the
595 indicated range. The alternatives need not cover the range; a default
596 target is provided for the missing alternatives.
598 If a join is necessary after the switch, the alternatives should
599 already finish with a jump to the join point.
604 :: StixTree -- discriminant
605 -> [(Literal, AbstractC)] -- alternatives
606 -> Integer -- low tag
607 -> Integer -- high tag
608 -> CLabel -- default label
609 -> UniqSM StixTreeList
612 mkJumpTable am alts lowTag highTag dflt
613 = getUniqLabelNCG `thenUs` \ utlbl ->
614 mapUs genLabel alts `thenUs` \ branches ->
615 let cjmpLo = StCondJump dflt (StMachOp MO_NatS_Lt [am, StInt (toInteger lowTag)])
616 cjmpHi = StCondJump dflt (StMachOp MO_NatS_Gt [am, StInt (toInteger highTag)])
618 offset = StMachOp MO_Nat_Sub [am, StInt lowTag]
619 dsts = DestInfo (dflt : map fst branches)
621 jump = StJump dsts (StInd PtrRep (StIndex PtrRep (StCLbl utlbl) offset))
623 table = StData PtrRep (mkTable branches [lowTag..highTag] [])
625 mapUs mkBranch branches `thenUs` \ alts ->
627 returnUs (\xs -> cjmpLo : cjmpHi : jump :
628 StSegment DataSegment : tlbl : table :
629 StSegment TextSegment : foldr1 (.) alts xs)
632 genLabel x = getUniqLabelNCG `thenUs` \ lbl -> returnUs (lbl, x)
634 mkBranch (lbl,(_,alt)) =
635 gencode alt `thenUs` \ alt_code ->
636 returnUs (\xs -> StLabel lbl : alt_code xs)
638 mkTable _ [] tbl = reverse tbl
639 mkTable [] (x:xs) tbl = mkTable [] xs (StCLbl dflt : tbl)
640 mkTable alts@((lbl,(tag,_)):rest) (x:xs) tbl
641 | intTag tag == x = mkTable rest xs (StCLbl lbl : tbl)
642 | otherwise = mkTable alts xs (StCLbl dflt : tbl)
646 We generate binary comparison trees when a jump table is inappropriate.
647 We expect to be given a list of alternatives, sorted by tag, and for
648 convenience, the length of the alternative list. We recursively break
649 the list in half and do a comparison on the first tag of the second half
650 of the list. (Odd lists are broken so that the second half of the list
651 is longer.) We can handle either integer or floating kind alternatives,
652 so long as they are not mixed. (We assume that the type of the discriminant
653 determines the type of the alternatives.)
655 As with the jump table approach, if a join is necessary after the switch, the
656 alternatives should already finish with a jump to the join point.
661 :: StixTree -- discriminant
662 -> Bool -- floating point?
663 -> [(Literal, AbstractC)] -- alternatives
664 -> Int -- number of choices
665 -> Literal -- low tag
666 -> Literal -- high tag
667 -> CLabel -- default code label
668 -> UniqSM StixTreeList
671 mkBinaryTree am floating [(tag,alt)] _ lowTag highTag udlbl
672 | rangeOfOne = gencode alt
674 = let tag' = a2stix (CLit tag)
675 cmpOp = if floating then MO_Dbl_Ne else MO_Nat_Ne
676 test = StMachOp cmpOp [am, tag']
677 cjmp = StCondJump udlbl test
679 gencode alt `thenUs` \ alt_code ->
680 returnUs (\xs -> cjmp : alt_code xs)
683 rangeOfOne = not floating && intTag lowTag + 1 >= intTag highTag
684 -- When there is only one possible tag left in range, we skip the comparison
686 mkBinaryTree am floating alts choices lowTag highTag udlbl
687 = getUniqLabelNCG `thenUs` \ uhlbl ->
688 let tag' = a2stix (CLit splitTag)
689 cmpOp = if floating then MO_Dbl_Ge else MO_NatS_Ge
690 test = StMachOp cmpOp [am, tag']
691 cjmp = StCondJump uhlbl test
693 mkBinaryTree am floating alts_lo half lowTag splitTag udlbl
694 `thenUs` \ lo_code ->
695 mkBinaryTree am floating alts_hi (choices - half) splitTag highTag udlbl
696 `thenUs` \ hi_code ->
698 returnUs (\xs -> cjmp : lo_code (StLabel uhlbl : hi_code xs))
701 half = choices `div` 2
702 (alts_lo, alts_hi) = splitAt half alts
703 splitTag = fst (head alts_hi)
710 :: CAddrMode -- discriminant
712 -> AbstractC -- if-part
713 -> AbstractC -- else-part
714 -> UniqSM StixTreeList
717 mkIfThenElse discrim tag alt deflt
718 = getUniqLabelNCG `thenUs` \ ujlbl ->
719 getUniqLabelNCG `thenUs` \ utlbl ->
720 let discrim' = a2stix discrim
721 tag' = a2stix (CLit tag)
722 cmpOp = if (isFloatingRep (getAmodeRep discrim)) then MO_Dbl_Ne else MO_Nat_Ne
723 test = StMachOp cmpOp [discrim', tag']
724 cjmp = StCondJump utlbl test
728 gencode (mkJoin alt ujlbl) `thenUs` \ alt_code ->
729 gencode deflt `thenUs` \ dflt_code ->
730 returnUs (\xs -> cjmp : alt_code (dest : dflt_code (join : xs)))
733 mkJoin :: AbstractC -> CLabel -> AbstractC
735 | mightFallThrough code = mkAbsCStmts code (CJump (CLbl lbl PtrRep))
739 %---------------------------------------------------------------------------
741 This answers the question: Can the code fall through to the next
742 line(s) of code? This errs towards saying True if it can't choose,
743 because it is used for eliminating needless jumps. In other words, if
744 you might possibly {\em not} jump, then say yes to falling through.
747 mightFallThrough :: AbstractC -> Bool
749 mightFallThrough absC = ft absC True
751 ft AbsCNop if_empty = if_empty
753 ft (CJump _) if_empty = False
754 ft (CReturn _ _) if_empty = False
755 ft (CSwitch _ alts deflt) if_empty
756 = ft deflt if_empty ||
757 or [ft alt if_empty | (_,alt) <- alts]
759 ft (AbsCStmts c1 c2) if_empty = ft c2 (ft c1 if_empty)
760 ft _ if_empty = if_empty
762 {- Old algorithm, which called nonemptyAbsC for every subexpression! =========
763 fallThroughAbsC (AbsCStmts c1 c2)
764 = case nonemptyAbsC c2 of
765 Nothing -> fallThroughAbsC c1
766 Just x -> fallThroughAbsC x
767 fallThroughAbsC (CJump _) = False
768 fallThroughAbsC (CReturn _ _) = False
769 fallThroughAbsC (CSwitch _ choices deflt)
770 = (not (isEmptyAbsC deflt) && fallThroughAbsC deflt)
771 || or (map (fallThroughAbsC . snd) choices)
772 fallThroughAbsC other = True
774 isEmptyAbsC :: AbstractC -> Bool
775 isEmptyAbsC = not . maybeToBool . nonemptyAbsC
776 ================= End of old, quadratic, algorithm -}