+import TyCon ( tyConFamilySize )
+import Type ( maybeAppDataTyConExpandingDicts )
+import UniqSet ( emptyUniqSet, unitUniqSet, mkUniqSet,
+ addOneToUniqSet, unionUniqSets
+ )
+import Usage ( SYN_IE(UVar) )
+import Util ( isIn, panic, assertPanic )
+
+whatsMentionedInId = panic "whatsMentionedInId (CoreUnfold)"
+getMentionedTyConsAndClassesFromType = panic "getMentionedTyConsAndClassesFromType (CoreUnfold)"
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{@Unfolding@ and @UnfoldingGuidance@ types}
+%* *
+%************************************************************************
+
+\begin{code}
+data Unfolding
+ = NoUnfolding
+ | CoreUnfolding SimpleUnfolding
+ | MagicUnfolding
+ Unique -- of the Id whose magic unfolding this is
+ MagicUnfoldingFun
+
+
+data SimpleUnfolding
+ = SimpleUnfolding FormSummary -- Tells whether the template is a WHNF or bottom
+ UnfoldingGuidance -- Tells about the *size* of the template.
+ TemplateOutExpr -- The template
+
+type TemplateOutExpr = GenCoreExpr (Id, BinderInfo) Id TyVar UVar
+ -- An OutExpr with occurrence info attached. This is used as
+ -- a template in GeneralForms.
+
+
+mkSimpleUnfolding form guidance template
+ = SimpleUnfolding form guidance template
+
+mkMagicUnfolding :: Unique -> Unfolding
+mkMagicUnfolding tag = MagicUnfolding tag (mkMagicUnfoldingFun tag)
+
+
+data UnfoldingGuidance
+ = UnfoldNever
+ | UnfoldAlways -- There is no "original" definition,
+ -- so you'd better unfold. Or: something
+ -- so cheap to unfold (e.g., 1#) that
+ -- you should do it absolutely always.
+
+ | UnfoldIfGoodArgs Int -- if "m" type args
+ Int -- and "n" value args
+ [Int] -- Discount if the argument is evaluated.
+ -- (i.e., a simplification will definitely
+ -- be possible). One elt of the list per *value* arg.
+ Int -- The "size" of the unfolding; to be elaborated
+ -- later. ToDo
+\end{code}
+
+\begin{code}
+instance Outputable UnfoldingGuidance where
+ ppr sty UnfoldAlways = ppStr "_ALWAYS_"
+-- ppr sty EssentialUnfolding = ppStr "_ESSENTIAL_" -- shouldn't appear in an iface
+ ppr sty (UnfoldIfGoodArgs t v cs size)
+ = ppCat [ppStr "_IF_ARGS_", ppInt t, ppInt v,
+ if null cs -- always print *something*
+ then ppChar 'X'
+ else ppBesides (map (ppStr . show) cs),
+ ppInt size ]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Figuring out things about expressions}
+%* *
+%************************************************************************
+
+\begin{code}
+data FormSummary
+ = VarForm -- Expression is a variable (or scc var, etc)
+ | ValueForm -- Expression is a value: i.e. a value-lambda,constructor, or literal
+ | BottomForm -- Expression is guaranteed to be bottom. We're more gung
+ -- ho about inlining such things, because it can't waste work
+ | OtherForm -- Anything else
+
+instance Outputable FormSummary where
+ ppr sty VarForm = ppStr "Var"
+ ppr sty ValueForm = ppStr "Value"
+ ppr sty BottomForm = ppStr "Bot"
+ ppr sty OtherForm = ppStr "Other"
+
+mkFormSummary ::GenCoreExpr bndr Id tyvar uvar -> FormSummary
+
+mkFormSummary expr
+ = go (0::Int) expr -- The "n" is the number of (value) arguments so far
+ where
+ go n (Lit _) = ASSERT(n==0) ValueForm
+ go n (Con _ _) = ASSERT(n==0) ValueForm
+ go n (Prim _ _) = OtherForm
+ go n (SCC _ e) = go n e
+ go n (Coerce _ _ e) = go n e
+ go n (Let _ e) = OtherForm
+ go n (Case _ _) = OtherForm
+
+ go 0 (Lam (ValBinder x) e) = ValueForm -- NB: \x.bottom /= bottom!
+ go n (Lam (ValBinder x) e) = go (n-1) e -- Applied lambda
+ go n (Lam other_binder e) = go n e
+
+ go n (App fun arg) | isValArg arg = go (n+1) fun
+ go n (App fun other_arg) = go n fun
+
+ go n (Var f) | isBottomingId f = BottomForm
+ go 0 (Var f) = VarForm
+ go n (Var f) = case (arityMaybe (getIdArity f)) of
+ Just arity | n < arity -> ValueForm
+ other -> OtherForm
+
+whnfOrBottom :: GenCoreExpr bndr Id tyvar uvar -> Bool
+whnfOrBottom e = case mkFormSummary e of
+ VarForm -> True
+ ValueForm -> True
+ BottomForm -> True
+ OtherForm -> False