- offending tyvar = ids_only_lvl `ltLvl` tyvarLevel tenv tyvar
-\end{code}
-
-
-\begin{code}
-{- ******** OMITTED NOW
-
-isWorthFloating :: Bool -- True <=> already let-bound
- -> CoreExpr -- The expression
- -> Bool
-
-isWorthFloating alreadyLetBound expr
-
- | alreadyLetBound = isWorthFloatingExpr expr
-
- | otherwise = -- No point in adding a fresh let-binding for a WHNF, because
- -- floating it isn't beneficial enough.
- isWorthFloatingExpr expr &&
- not (whnfOrBottom expr)
-********** -}
-
-isWorthFloatingExpr :: CoreExpr -> Bool
-
-isWorthFloatingExpr (Var v) = False
-isWorthFloatingExpr (Lit lit) = False
-isWorthFloatingExpr (App e arg)
- | notValArg arg = isWorthFloatingExpr e
-isWorthFloatingExpr (Con con as)
- | all notValArg as = False -- Just a type application
-isWorthFloatingExpr _ = True
-
-canFloatToTop :: (Type, CoreExprWithFVs) -> Bool
-
-canFloatToTop (ty, (FVInfo _ _ (LeakFree _), expr)) = True
-canFloatToTop (ty, (FVInfo _ _ MightLeak, expr)) = isLeakFreeType [] ty
-
-valSuggestsLeakFree expr = whnfOrBottom expr
-\end{code}
-
-
-
-%************************************************************************
-%* *
-\subsection{Help functions}
-%* *
-%************************************************************************
-
-\begin{code}
-idLevel :: IdEnv Level -> Id -> Level
-idLevel venv v
- = case lookupIdEnv venv v of
- Just level -> level
- Nothing -> tOP_LEVEL
-
-tyvarLevel :: TyVarEnv Level -> TyVar -> Level
-tyvarLevel tenv tyvar
- = case lookupTyVarEnv tenv tyvar of
- Just level -> level
- Nothing -> tOP_LEVEL
-\end{code}
-
-\begin{code}
-annCollectValBinders (_, (AnnLam (ValBinder arg) rhs))
- = (arg:args, body)
- where
- (args, body) = annCollectValBinders rhs
-
-annCollectValBinders body
- = ([], body)