X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FClosureInfo.lhs;h=18734e13aabc4d85544394b55e1dbedb025e60ab;hb=984a288119983912d40a80845c674ee4b83a19ce;hp=bc7dfec1b0f2916c80d917c4fbe3370c9c5a8f53;hpb=fa719676416bb6271bdac979ec294e81ed7404c3;p=ghc-hetmet.git diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index bc7dfec..18734e1 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -72,7 +72,6 @@ import Id import IdInfo import DataCon import Name -import OccName import Type import TypeRep import TcType @@ -260,7 +259,7 @@ mkLFReEntrant top fvs args arg_descr mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo mkLFThunk thunk_ty top fvs upd_flag - = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) ) + = ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty $$ ppr fvs ) LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk @@ -598,6 +597,10 @@ getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args | otherwise = DirectEntry (enterIdLabel name caf) arity getCallMethod _ _ _ (LFCon con) n_args + | opt_SccProfilingOn -- when profiling, we must always enter + = EnterIt -- a closure when we use it, so that the closure + -- can be recorded as used for LDV profiling. + | otherwise = ASSERT( n_args == 0 ) ReturnCon con