From af331a6f6091463adc01778f2250cdc5294dbb8d Mon Sep 17 00:00:00 2001 From: simonpj Date: Mon, 26 Feb 2001 15:42:00 +0000 Subject: [PATCH] [project @ 2001-02-26 15:42:00 by simonpj] Move findDefault, findAlt from SimplUtils to CoreUtils --- ghc/compiler/coreSyn/CoreUtils.lhs | 32 ++++++++++++++++++++++++++++++++ ghc/compiler/simplCore/SimplUtils.lhs | 25 ++++--------------------- 2 files changed, 36 insertions(+), 21 deletions(-) diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs index f0649d1..30e6746 100644 --- a/ghc/compiler/coreSyn/CoreUtils.lhs +++ b/ghc/compiler/coreSyn/CoreUtils.lhs @@ -10,6 +10,9 @@ module CoreUtils ( bindNonRec, mkIfThenElse, mkAltExpr, mkPiType, + -- Taking expressions apart + findDefault, findAlt, + -- Properties of expressions exprType, coreAltsType, exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap, @@ -242,6 +245,35 @@ mkIfThenElse guard then_expr else_expr (DataAlt falseDataCon, [], else_expr) ] \end{code} + +%************************************************************************ +%* * +\subsection{Taking expressions apart} +%* * +%************************************************************************ + + +\begin{code} +findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr) +findDefault [] = ([], Nothing) +findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null alts && null args ) + ([], Just rhs) +findDefault (alt : alts) = case findDefault alts of + (alts', deflt) -> (alt : alts', deflt) + +findAlt :: AltCon -> [CoreAlt] -> CoreAlt +findAlt con alts + = go alts + where + go [] = pprPanic "Missing alternative" (ppr con $$ vcat (map ppr alts)) + go (alt : alts) | matches alt = alt + | otherwise = go alts + + matches (DEFAULT, _, _) = True + matches (con1, _, _) = con == con1 +\end{code} + + %************************************************************************ %* * \subsection{Figuring out things about expressions} diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs index 2732f0a..387cbd8 100644 --- a/ghc/compiler/simplCore/SimplUtils.lhs +++ b/ghc/compiler/simplCore/SimplUtils.lhs @@ -7,7 +7,7 @@ module SimplUtils ( simplBinder, simplBinders, simplIds, tryRhsTyLam, tryEtaExpansion, - mkCase, findAlt, findDefault, + mkCase, -- The continuation type SimplCont(..), DupFlag(..), contIsDupable, contResultType, @@ -24,7 +24,9 @@ import CmdLineOpts ( switchIsOn, SimplifierSwitch(..), ) import CoreSyn import CoreUtils ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, - etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce ) + etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce, + findDefault, findAlt + ) import Subst ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr ) import Id ( idType, idName, idUnfolding, idStrictness, @@ -822,22 +824,3 @@ mkCase other_scrut case_bndr other_alts \end{code} -\begin{code} -findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr) -findDefault [] = ([], Nothing) -findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null alts && null args ) - ([], Just rhs) -findDefault (alt : alts) = case findDefault alts of - (alts', deflt) -> (alt : alts', deflt) - -findAlt :: AltCon -> [CoreAlt] -> CoreAlt -findAlt con alts - = go alts - where - go [] = pprPanic "Missing alternative" (ppr con $$ vcat (map ppr alts)) - go (alt : alts) | matches alt = alt - | otherwise = go alts - - matches (DEFAULT, _, _) = True - matches (con1, _, _) = con == con1 -\end{code} -- 1.7.10.4