X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreUtils.lhs;h=d7a91a00be06dab9ec6c2aeee6f9da1fa9cea908;hb=979947f545d70c63edb7ca96f6e47008ac90e3bf;hp=4e61e8304e738756482fdf3ca4d16c016d9f36ca;hpb=51666a19707f4ca34eec28a14bffbbc7d642e647;p=ghc-hetmet.git diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs index 4e61e83..d7a91a0 100644 --- a/ghc/compiler/coreSyn/CoreUtils.lhs +++ b/ghc/compiler/coreSyn/CoreUtils.lhs @@ -57,7 +57,7 @@ import IdInfo ( LBVarInfo(..), megaSeqIdInfo ) import NewDemand ( appIsBottom ) import Type ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe, splitFunTy, - applyTys, isUnLiftedType, seqType, mkUTy, mkTyVarTy, + applyTys, isUnLiftedType, seqType, mkTyVarTy, splitForAllTy_maybe, isForAllTy, splitNewType_maybe, splitTyConApp_maybe, eqType, funResultTy, applyTy, funResultTy, applyTy @@ -111,12 +111,8 @@ mkPiTypes :: [Var] -> Type -> Type -- doesn't work... mkPiTypes vs ty = foldr mkPiType ty vs mkPiType v ty - | isId v = add_usage (mkFunTy (idType v) ty) + | isId v = mkFunTy (idType v) ty | otherwise = mkForAllTy v ty - where - add_usage ty = case idLBVarInfo v of - LBVarInfo u -> mkUTy u ty - otherwise -> ty \end{code} \begin{code} @@ -1019,7 +1015,7 @@ coreBindsSize bs = foldr ((+) . bindSize) 0 bs exprSize :: CoreExpr -> Int -- A measure of the size of the expressions -- It also forces the expression pretty drastically as a side effect -exprSize (Var v) = varSize v +exprSize (Var v) = v `seq` 1 exprSize (Lit lit) = lit `seq` 1 exprSize (App f a) = exprSize f + exprSize a exprSize (Lam b e) = varSize b + exprSize e