X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FClosureInfo.lhs;h=73f9e6f4b79319ac71443622a6fb11fcfbcaa025;hp=f7eb45a53908ccea06d255fa7f708eaffe5b1d94;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hpb=7b0181919416d8f04324575b7e17031ca692f5b0 diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index f7eb45a..73f9e6f 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -25,7 +25,7 @@ module ClosureInfo ( layOutDynClosure, layOutDynCon, layOutStaticClosure, layOutStaticNoFVClosure, layOutPhantomClosure, - mkVirtHeapOffsets, -- for GHCI + mkVirtHeapOffsets, nodeMustPointToIt, getEntryConvention, blackHoleOnEntry, @@ -41,6 +41,7 @@ module ClosureInfo ( closureSingleEntry, closureSemiTag, closureType, closureReturnsUnboxedType, getStandardFormThunkInfo, + isToplevClosure, closureKind, closureTypeDescr, -- profiling isStaticClosure, allocProfilingMsg, @@ -50,8 +51,8 @@ module ClosureInfo ( dataConLiveness -- concurrency ) where -import Ubiq{-uitous-} -import AbsCLoop -- here for paranoia-checking +IMP_Ubiq(){-uitous-} +IMPORT_DELOOPER(AbsCLoop) -- here for paranoia-checking import AbsCSyn import StgSyn @@ -68,6 +69,7 @@ import CgRetConv ( assignRegs, dataReturnConvAlg, ) import CLabel ( mkStdEntryLabel, mkFastEntryLabel, mkPhantomInfoTableLabel, mkInfoTableLabel, + mkConInfoTableLabel, mkBlackHoleInfoTableLabel, mkVapInfoTableLabel, mkStaticInfoTableLabel, mkStaticConEntryLabel, mkConEntryLabel, mkClosureLabel, mkVapEntryLabel @@ -75,30 +77,29 @@ import CLabel ( mkStdEntryLabel, mkFastEntryLabel, import CmdLineOpts ( opt_SccProfilingOn, opt_ForConcurrent ) import HeapOffs ( intOff, addOff, totHdrSize, varHdrSize, intOffsetIntoGoods, - VirtualHeapOffset(..) + SYN_IE(VirtualHeapOffset) ) import Id ( idType, idPrimRep, getIdArity, - externallyVisibleId, dataConSig, + externallyVisibleId, dataConTag, fIRST_TAG, - isDataCon, dataConArity, dataConTyCon, - isTupleCon, DataCon(..), + isDataCon, isNullaryDataCon, dataConTyCon, + isTupleCon, SYN_IE(DataCon), GenId{-instance Eq-} ) import IdInfo ( arityMaybe ) import Maybes ( assocMaybe, maybeToBool ) -import Name ( isLocallyDefined, getLocalName ) +import Name ( isLocallyDefined, nameOf, origName ) import PprStyle ( PprStyle(..) ) -import PprType ( GenType{-instance Outputable-} ) +import PprType ( getTyDescription, GenType{-instance Outputable-} ) +--import Pretty--ToDo:rm +import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon ) import PrimRep ( getPrimRepSize, separateByPtrFollowness ) import SMRep -- all of it import TyCon ( maybeTyConSingleCon, TyCon{-instance NamedThing-} ) -import Type ( isPrimType, splitForAllTy, splitFunTy, mkFunTys ) +import Type ( isPrimType, splitForAllTy, splitFunTyExpandingDictsAndPeeking, + mkFunTys, maybeAppSpecDataTyConExpandingDicts + ) import Util ( isIn, mapAccumL, panic, pprPanic, assertPanic ) - -maybeCharLikeTyCon = panic "ClosureInfo.maybeCharLikeTyCon (ToDo)" -maybeIntLikeTyCon = panic "ClosureInfo.maybeIntLikeTyCon (ToDo)" -getDataSpecTyCon_maybe = panic "ClosureInfo.getDataSpecTyCon_maybe (ToDo)" -getTyDescription = panic "ClosureInfo.getTyDescription (ToDo)" \end{code} The ``wrapper'' data type for closure information: @@ -425,7 +426,7 @@ mkClosureLFInfo False -- don't bother if at top-level offset_into_int_maybe = intOffsetIntoGoods the_offset Just offset_into_int = offset_into_int_maybe is_single_constructor = maybeToBool (maybeTyConSingleCon tycon) - (_,_,_, tycon) = dataConSig con + tycon = dataConTyCon con \end{code} Same kind of thing, looking for vector-apply thunks, of the form: @@ -477,14 +478,8 @@ isUpdatable Updatable = True mkConLFInfo :: DataCon -> LambdaFormInfo mkConLFInfo con - = ASSERT(isDataCon con) - let - arity = dataConArity con - in - if isTupleCon con then - LFTuple con (arity == 0) - else - LFCon con (arity == 0) + = -- the isNullaryDataCon will do this: ASSERT(isDataCon con) + (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con) \end{code} @@ -865,8 +860,8 @@ data EntryConvention Int -- Its arity [MagicId] -- Its register assignments (possibly empty) -getEntryConvention :: Id -- Function being applied - -> LambdaFormInfo -- Its info +getEntryConvention :: Id -- Function being applied + -> LambdaFormInfo -- Its info -> [PrimRep] -- Available arguments -> FCode EntryConvention @@ -894,13 +889,14 @@ getEntryConvention id lf_info arg_kinds -> let itbl = if zero_arity then mkPhantomInfoTableLabel con else - mkInfoTableLabel con - in StdEntry (mkStdEntryLabel con) (Just itbl) - -- Should have no args + mkConInfoTableLabel con + in + --false:ASSERT (null arg_kinds) -- Should have no args (meaning what?) + StdEntry (mkConEntryLabel con) (Just itbl) + LFTuple tup zero_arity - -> StdEntry (mkStdEntryLabel tup) - (Just (mkInfoTableLabel tup)) - -- Should have no args + -> --false:ASSERT (null arg_kinds) -- Should have no args (meaning what?) + StdEntry (mkConEntryLabel tup) (Just (mkConInfoTableLabel tup)) LFThunk _ _ updatable std_form_info -> if updatable @@ -1136,9 +1132,9 @@ closureType :: ClosureInfo -> Maybe (TyCon, [Type], [Id]) -- rather than take it from the Id. The Id is probably just "f"! closureType (MkClosureInfo id (LFThunk _ _ _ (VapThunk fun_id args _)) _) - = getDataSpecTyCon_maybe (fun_result_ty (length args) fun_id) + = maybeAppSpecDataTyConExpandingDicts (fun_result_ty (length args) fun_id) -closureType (MkClosureInfo id lf _) = getDataSpecTyCon_maybe (idType id) +closureType (MkClosureInfo id lf _) = maybeAppSpecDataTyConExpandingDicts (idType id) \end{code} @closureReturnsUnboxedType@ is used to check whether a closure, {\em @@ -1163,9 +1159,10 @@ closureReturnsUnboxedType other_closure = False fun_result_ty arity id = let (_, de_foralld_ty) = splitForAllTy (idType id) - (arg_tys, res_ty) = splitFunTy{-w/ dicts as args?-} de_foralld_ty + (arg_tys, res_ty) = splitFunTyExpandingDictsAndPeeking de_foralld_ty in ASSERT(arity >= 0 && length arg_tys >= arity) +-- (if (arity >= 0 && length arg_tys >= arity) then (\x->x) else pprPanic "fun_result_ty:" (ppCat [ppInt arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $ mkFunTys (drop arity arg_tys) res_ty \end{code} @@ -1179,6 +1176,16 @@ closureSemiTag (MkClosureInfo _ lf_info _) _ -> fromInteger oTHER_TAG \end{code} +\begin{code} +isToplevClosure :: ClosureInfo -> Bool + +isToplevClosure (MkClosureInfo _ lf_info _) + = case lf_info of + LFReEntrant top _ _ -> top + LFThunk top _ _ _ -> top + _ -> panic "ClosureInfo:isToplevClosure" +\end{code} + Label generation. \begin{code} @@ -1213,17 +1220,19 @@ infoTableLabelFromCI (MkClosureInfo id lf_info rep) else -} mkInfoTableLabel id mkConInfoPtr :: Id -> SMRep -> CLabel -mkConInfoPtr id rep = - case rep of - PhantomRep -> mkPhantomInfoTableLabel id - StaticRep _ _ -> mkStaticInfoTableLabel id - _ -> mkInfoTableLabel id +mkConInfoPtr con rep + = ASSERT(isDataCon con) + case rep of + PhantomRep -> mkPhantomInfoTableLabel con + StaticRep _ _ -> mkStaticInfoTableLabel con + _ -> mkConInfoTableLabel con mkConEntryPtr :: Id -> SMRep -> CLabel -mkConEntryPtr id rep = - case rep of - StaticRep _ _ -> mkStaticConEntryLabel id - _ -> mkConEntryLabel id +mkConEntryPtr con rep + = ASSERT(isDataCon con) + case rep of + StaticRep _ _ -> mkStaticConEntryLabel con + _ -> mkConEntryLabel con closureLabelFromCI (MkClosureInfo id _ _) = mkClosureLabel id @@ -1252,7 +1261,7 @@ fastLabelFromCI (MkClosureInfo id _ _) = mkFastEntryLabel id fun_arity arity_maybe = arityMaybe (getIdArity id) fun_arity = case arity_maybe of Just x -> x - _ -> pprPanic "fastLabelFromCI:no arity:" (ppr PprShowAll id) + _ -> panic "fastLabelFromCI:no arity:" --(ppr PprShowAll id) \end{code} \begin{code} @@ -1322,8 +1331,8 @@ closureKind (MkClosureInfo _ lf _) closureTypeDescr :: ClosureInfo -> String closureTypeDescr (MkClosureInfo id lf _) - = if (isDataCon id) then -- DataCon has function types - _UNPK_ (getLocalName (dataConTyCon id)) -- We want the TyCon not the -> + = if (isDataCon id) then -- DataCon has function types + _UNPK_ (nameOf (origName "closureTypeDescr" (dataConTyCon id))) -- We want the TyCon not the -> else getTyDescription (idType id) \end{code}