on master help sign in
Express a multiway "if" differently (GHC compat).
21319b8Matus Tejiscak
src/IRTS/Compiler.hs+7−7
@@ -698,18 +698,18 @@ irSC top vs (Case up n alts@[ConCase cn a ns sc, DefaultCase sc']) = do
698 -- the usual case
698 -- the usual case
699 _ -> LCase up (LV n) <$> mapM (irAlt top vs (LV n)) alts
699 _ -> LCase up (LV n) <$> mapM (irAlt top vs (LV n)) alts
700
700
701−irSC top vs sc@(Case up n alts) = do
701+irSC top vs sc@(Case up n alts) = getIState >>= rhs
702− ist <- getIState
702+ where
703−
703+ rhs ist
704− if | [ConCase cns as nss scs, ConCase cnz az nsz scz] <- alts
704+ | [ConCase cns as nss scs, ConCase cnz az nsz scz] <- alts
705 , Just LikeS <- isLikeNat ist cns
705 , Just LikeS <- isLikeNat ist cns
706− -> do
706+ = do
707 -- reorder to make the Z case come first
707 -- reorder to make the Z case come first
708 zCase <- LConstCase (BI 0) <$> irSC top vs scz
708 zCase <- LConstCase (BI 0) <$> irSC top vs scz
709 sCase <- irAlt top vs (LV n) (ConCase cns as nss scs)
709 sCase <- irAlt top vs (LV n) (ConCase cns as nss scs)
710 return $ LCase up (LV n) [zCase, sCase]
710 return $ LCase up (LV n) [zCase, sCase]
711
711
712− | otherwise -> do
712+ | otherwise = do
713 -- check that neither alternative needs the newtype optimisation,
713 -- check that neither alternative needs the newtype optimisation,
714 -- see comment above
714 -- see comment above
715 goneWrong <- or <$> mapM isDetaggable alts
715 goneWrong <- or <$> mapM isDetaggable alts
@@ -718,7 +718,7 @@ irSC top vs sc@(Case up n alts) = do
718
718
719 -- everything okay
719 -- everything okay
720 LCase up (LV n) <$> mapM (irAlt top vs (LV n)) alts
720 LCase up (LV n) <$> mapM (irAlt top vs (LV n)) alts
721− where
721+
722 isDetaggable (ConCase cn _ _ _) = fgetState $ opt_detaggable . ist_optimisation cn
722 isDetaggable (ConCase cn _ _ _) = fgetState $ opt_detaggable . ist_optimisation cn
723 isDetaggable _ = return False
723 isDetaggable _ = return False
724
724