@@ -543,21 +543,31 @@ irSC vs (Case n [alt]) = do
543 subexpr (LConstCase _ e) = e
543 subexpr (LConstCase _ e) = e
544 subexpr (LDefaultCase e) = e
544 subexpr (LDefaultCase e) = e
546−-- When we have a non-singleton case-tree of the form
546+-- FIXME: When we have a non-singleton case-tree of the form
548-- case {e0} of
548-- case {e0} of
549-- C(x) => ...
549-- C(x) => ...
550-- ... => ...
550-- ... => ...
552−-- and C is detaggable (= the only constructor of the family),
552+-- and C is detaggable (the only constructor of the family), we can be sure
553−-- something has gone wrong.
553+-- that the first branch will be always taken -- so we add special handling
554+-- to remove the dead default branch.
555−-- Especially, if C is newtype-optimisable, we will miss this newtype
556+-- If we don't do so and C is newtype-optimisable, we will miss this newtype
556-- transformation and the resulting code will probably segfault.
557-- transformation and the resulting code will probably segfault.
558−-- Therefore we first have to check that all alts here are non-trivial.
559+-- This work-around is not entirely optimal; the best approach would be
560+-- to ensure that such case trees don't arise in the first place.
562+irSC vs (Case n alts@[ConCase cn a ns sc, DefaultCase sc']) = do
563+ detag <- fgetState (opt_detaggable . ist_optimisation cn)
565+ then irSC vs (Case n [ConCase cn a ns sc])
566+ else LCase (LV (Glob n)) <$> mapM (irAlt vs (LV (Glob n))) alts
560irSC vs sc@(Case n alts) = do
568irSC vs sc@(Case n alts) = do
569+ -- check that neither alternative needs the newtype optimisation,
570+ -- see comment above
561 goneWrong <- or <$> mapM isDetaggable alts
571 goneWrong <- or <$> mapM isDetaggable alts
562 when goneWrong
572 when goneWrong
563 $ ifail ("irSC: non-trivial case-match on detaggable data: " ++ show sc)
573 $ ifail ("irSC: non-trivial case-match on detaggable data: " ++ show sc)