import CmdLineOpts ( FloatOutSwitches(..) )
import CoreUtils ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
import CoreFVs -- all of it
-import Subst
+import Subst ( Subst, SubstResult(..), emptySubst, extendInScope, extendIdSubst,
+ substAndCloneId, substAndCloneRecIds )
import Id ( Id, idType, mkSysLocalUnencoded,
isOneShotLambda, zapDemandIdInfo,
idSpecialisation, idWorkerInfo, setIdInfo
import Type ( isUnLiftedType, Type )
import BasicTypes ( TopLevelFlag(..) )
import UniqSupply
-import Util ( sortLt, isSingleton, count )
+import Util ( sortLe, isSingleton, count )
import Outputable
import FastString
\end{code}
lvlMFE False ctxt_lvl env arg `thenLvl` \ arg' ->
returnLvl (App fun' arg')
where
- lvl_fun (_, AnnCase _ _ _) = lvlMFE True ctxt_lvl env fun
+-- gaw 2004
+ lvl_fun (_, AnnCase _ _ _ _) = lvlMFE True ctxt_lvl env fun
lvl_fun other = lvlExpr ctxt_lvl env fun
-- We don't do MFE on partial applications generally,
-- but we do if the function is big and hairy, like a case
lvlExpr ctxt_lvl new_env body `thenLvl` \ body' ->
returnLvl (Let bind' body')
-lvlExpr ctxt_lvl env (_, AnnCase expr case_bndr alts)
+lvlExpr ctxt_lvl env (_, AnnCase expr case_bndr ty alts)
= lvlMFE True ctxt_lvl env expr `thenLvl` \ expr' ->
let
alts_env = extendCaseBndrLvlEnv env expr' case_bndr incd_lvl
in
mapLvl (lvl_alt alts_env) alts `thenLvl` \ alts' ->
- returnLvl (Case expr' (TB case_bndr incd_lvl) alts')
+ returnLvl (Case expr' (TB case_bndr incd_lvl) ty alts')
where
incd_lvl = incMinorLvl ctxt_lvl
extendCaseBndrLvlEnv (float_lams, lvl_env, subst, id_env) (Var scrut_var) case_bndr lvl
= (float_lams,
extendVarEnv lvl_env case_bndr lvl,
- extendSubst subst case_bndr (DoneEx (Var scrut_var)),
+ extendIdSubst subst case_bndr (DoneEx (Var scrut_var)),
extendVarEnv id_env case_bndr ([scrut_var], Var scrut_var))
extendCaseBndrLvlEnv env scrut case_bndr lvl
foldl add_id id_env bndr_pairs)
where
add_lvl env (v,v') = extendVarEnv env v' dest_lvl
- add_subst env (v,v') = extendSubst env v (DoneEx (mkVarApps (Var v') abs_vars))
+ add_subst env (v,v') = extendIdSubst env v (DoneEx (mkVarApps (Var v') abs_vars))
add_id env (v,v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
extendCloneLvlEnv lvl (float_lams, lvl_env, _, id_env) new_subst bndr_pairs
-- whose level is greater than the destination level
-- These are the ones we are going to abstract out
abstractVars dest_lvl env fvs
- = uniq (sortLt lt [var | fv <- varSetElems fvs, var <- absVarsOf dest_lvl env fv])
+ = uniq (sortLe le [var | fv <- varSetElems fvs, var <- absVarsOf dest_lvl env fv])
where
-- Sort the variables so we don't get
-- mixed-up tyvars and Ids; it's just messy
- v1 `lt` v2 = case (isId v1, isId v2) of
+ v1 `le` v2 = case (isId v1, isId v2) of
(True, False) -> False
(False, True) -> True
- other -> v1 < v2 -- Same family
+ other -> v1 <= v2 -- Same family
uniq :: [Var] -> [Var]
-- Remove adjacent duplicates; the sort will have brought them together