mkVirtHeapOffsets,
nodeMustPointToIt, getEntryConvention,
- blackHoleOnEntry, lfArity_maybe,
+ blackHoleOnEntry,
staticClosureRequired,
slowFunEntryCodeRequired, funInfoTableRequired,
)
import CLabel ( mkStdEntryLabel, mkFastEntryLabel,
mkPhantomInfoTableLabel, mkInfoTableLabel,
- mkConInfoTableLabel,
+ mkConInfoTableLabel, mkStaticClosureLabel,
mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
mkStaticInfoTableLabel, mkStaticConEntryLabel,
mkConEntryLabel, mkClosureLabel, mkVapEntryLabel
)
import CmdLineOpts ( opt_SccProfilingOn, opt_ForConcurrent )
import HeapOffs ( intOff, addOff, totHdrSize, varHdrSize,
- SYN_IE(VirtualHeapOffset)
+ SYN_IE(VirtualHeapOffset), HeapOffset
)
import Id ( idType, getIdArity,
externallyVisibleId,
dataConTag, fIRST_TAG,
- isDataCon, isNullaryDataCon, dataConTyCon, dataConArity,
+ isDataCon, isNullaryDataCon, dataConTyCon,
isTupleCon, SYN_IE(DataCon),
- GenId{-instance Eq-}
+ GenId{-instance Eq-}, SYN_IE(Id)
)
import IdInfo ( ArityInfo(..) )
import Maybes ( maybeToBool )
import Name ( getOccString )
-import PprStyle ( PprStyle(..) )
+import Outputable ( PprStyle(..), Outputable(..) )
import PprType ( getTyDescription, GenType{-instance Outputable-} )
import Pretty --ToDo:rm
import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
-import PrimRep ( getPrimRepSize, separateByPtrFollowness )
+import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
import SMRep -- all of it
import TyCon ( TyCon{-instance NamedThing-} )
-import Type ( isPrimType, expandTy, splitForAllTy, splitFunTyExpandingDictsAndPeeking,
- mkFunTys, maybeAppSpecDataTyConExpandingDicts
+import Type ( isPrimType, splitFunTyExpandingDictsAndPeeking,
+ mkFunTys, maybeAppSpecDataTyConExpandingDicts,
+ SYN_IE(Type)
)
import Util ( isIn, mapAccumL, panic, pprPanic, assertPanic )
\end{code}
@lfArity@ extracts the arity of a function from its LFInfo
\begin{code}
+{- Not needed any more
+
lfArity_maybe (LFReEntrant _ arity _) = Just arity
-lfArity_maybe (LFCon con _) = Just (dataConArity con)
-lfArity_maybe (LFTuple con _) = Just (dataConArity con)
+
+-- Removed SLPJ March 97. I don't believe these two;
+-- LFCon is used for construcor *applications*, not constructors!
+--
+-- lfArity_maybe (LFCon con _) = Just (dataConArity con)
+-- lfArity_maybe (LFTuple con _) = Just (dataConArity con)
+
lfArity_maybe other = Nothing
+-}
\end{code}
%************************************************************************
(arg_tys, res_ty) = splitFunTyExpandingDictsAndPeeking (idType id)
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)])) $
+ (if (arity >= 0 && length arg_tys >= arity) then (\x->x) else pprPanic "fun_result_ty:" (hsep [int arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $
mkFunTys (drop arity arg_tys) res_ty
\end{code}
\begin{code}
fastLabelFromCI :: ClosureInfo -> CLabel
fastLabelFromCI (MkClosureInfo id lf_info _)
+{- [SLPJ Changed March 97]
+ (was ok, but is the only call to lfArity,
+ and the id should guarantee to have the correct arity in it.
+
= case lfArity_maybe lf_info of
- Just arity -> mkFastEntryLabel id arity
- other -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
+ Just arity ->
+-}
+ = case getIdArity id of
+ ArityExactly arity -> mkFastEntryLabel id arity
+ other -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI (MkClosureInfo id lf_info rep)
_ -> mkConEntryLabel con
-closureLabelFromCI (MkClosureInfo id _ _) = mkClosureLabel id
+closureLabelFromCI (MkClosureInfo id _ rep)
+ | isConstantRep rep
+ = mkStaticClosureLabel id
+ -- This case catches those pesky static closures for nullary constructors
+
+closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI (MkClosureInfo id lf_info rep)