-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[ClosureInfo]{Data structures which describe closures}
EntryConvention(..),
- mkClosureLFInfo, mkConLFInfo,
+ mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkVapLFInfo,
mkLFImported, mkLFArgument, mkLFLetNoEscape,
+ UpdateFlag,
closureSize, closureHdrSize,
closureNonHdrSize, closureSizeWithoutFixedHdr,
layOutDynClosure, layOutDynCon, layOutStaticClosure,
layOutStaticNoFVClosure, layOutPhantomClosure,
- mkVirtHeapOffsets, -- for GHCI
+ mkVirtHeapOffsets,
+
+ nodeMustPointToIt, getEntryConvention,
+ SYN_IE(FCode), CgInfoDownwards, CgState,
- nodeMustPointToIt, getEntryConvention,
blackHoleOnEntry,
staticClosureRequired,
slowFunEntryCodeRequired, funInfoTableRequired,
stdVapRequired, noUpdVapRequired,
+ StgBinderInfo,
- closureId, infoTableLabelFromCI,
+ closureId, infoTableLabelFromCI, fastLabelFromCI,
closureLabelFromCI,
- entryLabelFromCI, fastLabelFromCI,
+ entryLabelFromCI,
closureLFInfo, closureSMRep, closureUpdReqd,
closureSingleEntry, closureSemiTag, closureType,
closureReturnsUnboxedType, getStandardFormThunkInfo,
+ GenStgArg,
+ isToplevClosure,
closureKind, closureTypeDescr, -- profiling
- isConstantRep, isSpecRep, isPhantomRep, -- ToDo: Should be in SMRep, perhaps?
isStaticClosure, allocProfilingMsg,
blackHoleClosureInfo,
- getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr,
- ltSMRepHdr,
maybeSelectorInfo,
dataConLiveness -- concurrency
-
- -- and to make the interface self-sufficient...
) where
-import AbsCSyn
-import CgMonad
-import SMRep
+IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(AbsCLoop) -- here for paranoia-checking
+#endif
+
+import AbsCSyn ( MagicId, node, mkLiveRegsMask,
+ {- GHC 0.29 only -} AbstractC, CAddrMode
+ )
import StgSyn
+import CgMonad
-import Type
-import CgCompInfo -- some magic constants
-import CgRetConv
-import CLabel -- Lots of label-making things
-import CmdLineOpts ( GlobalSwitch(..) )
-import Id
-import IdInfo -- SIGH
-import Maybes ( maybeToBool, assocMaybe, Maybe(..) )
-import Outputable -- needed for INCLUDE_FRC_METHOD
-import Pretty -- ( ppStr, Pretty(..) )
-import PrimRep ( PrimRep, getPrimRepSize, separateByPtrFollowness )
-import Util
+import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
+ mAX_SPEC_ALL_PTRS, mAX_SPEC_MIXED_FIELDS,
+ mAX_SPEC_ALL_NONPTRS,
+ oTHER_TAG
+ )
+import CgRetConv ( assignRegs, dataReturnConvAlg,
+ DataReturnConvention(..)
+ )
+import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
+ mkPhantomInfoTableLabel, mkInfoTableLabel,
+ mkConInfoTableLabel, mkStaticClosureLabel,
+ mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
+ mkStaticInfoTableLabel, mkStaticConEntryLabel,
+ mkConEntryLabel, mkClosureLabel, mkVapEntryLabel
+ )
+import CmdLineOpts ( opt_SccProfilingOn, opt_ForConcurrent )
+import HeapOffs ( intOff, addOff, totHdrSize, varHdrSize,
+ SYN_IE(VirtualHeapOffset), HeapOffset
+ )
+import Id ( idType, getIdArity,
+ externallyVisibleId,
+ dataConTag, fIRST_TAG,
+ isDataCon, isNullaryDataCon, dataConTyCon,
+ isTupleCon, SYN_IE(DataCon),
+ GenId{-instance Eq-}, SYN_IE(Id)
+ )
+import IdInfo ( ArityInfo(..) )
+import Maybes ( maybeToBool )
+import Name ( getOccString )
+import Outputable ( PprStyle(..), Outputable(..) )
+import PprType ( getTyDescription, GenType{-instance Outputable-} )
+import Pretty --ToDo:rm
+import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
+import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
+import SMRep -- all of it
+import TyCon ( TyCon{-instance NamedThing-} )
+import Type ( isPrimType, splitFunTyExpandingDictsAndPeeking,
+ mkFunTys, maybeAppSpecDataTyConExpandingDicts,
+ SYN_IE(Type)
+ )
+import Util ( isIn, mapAccumL, panic, pprPanic, assertPanic )
\end{code}
The ``wrapper'' data type for closure information:
mkLFImported :: Id -> LambdaFormInfo
mkLFImported id
- = case arityMaybe (getIdArity id) of
- Nothing -> LFImported
- Just 0 -> LFThunk True{-top-lev-} True{-no fvs-}
- True{-updatable-} NonStandardThunk
- Just n -> LFReEntrant True n True -- n > 0
+ = case getIdArity id of
+ ArityExactly 0 -> LFThunk True{-top-lev-} True{-no fvs-}
+ True{-updatable-} NonStandardThunk
+ ArityExactly n -> LFReEntrant True n True -- n > 0
+ other -> LFImported -- Not sure of exact arity
\end{code}
%************************************************************************
-> [Id] -- Free vars
-> UpdateFlag -- Update flag
-> [Id] -- Args
- -> StgExpr -- Body of closure: passed so we
- -- can look for selector thunks!
-> LambdaFormInfo
-mkClosureLFInfo top fvs upd_flag args@(_:_) body -- Non-empty args
+mkClosureLFInfo top fvs upd_flag args@(_:_) -- Non-empty args
= LFReEntrant top (length args) (null fvs)
-mkClosureLFInfo top fvs ReEntrant [] body
+mkClosureLFInfo top fvs ReEntrant []
= LFReEntrant top 0 (null fvs)
-\end{code}
-
-OK, this is where we look at the body of the closure to see if it's a
-selector---turgid, but nothing deep. We are looking for a closure of
-{\em exactly} the form:
-\begin{verbatim}
-... = [the_fv] \ u [] ->
- case the_fv of
- con a_1 ... a_n -> a_i
-\end{verbatim}
-Here we go:
-\begin{code}
-mkClosureLFInfo False -- don't bother if at top-level
- [the_fv] -- just one...
- Updatable
- [] -- no args (a thunk)
- (StgCase (StgApp (StgVarArg scrutinee) [{-no args-}] _)
- _ _ _ -- ignore live vars and uniq...
- (StgAlgAlts case_ty
- [(con, params, use_mask,
- (StgApp (StgVarArg selectee) [{-no args-}] _))]
- StgNoDefault))
- | the_fv == scrutinee -- Scrutinee is the only free variable
- && maybeToBool maybe_offset -- Selectee is a component of the tuple
- && maybeToBool offset_into_int_maybe
- && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
- =
- -- ASSERT(is_single_constructor) -- Should be true, by causes error for SpecTyCon
- LFThunk False False True (SelectorThunk scrutinee con offset_into_int)
- where
- (_, params_w_offsets) = layOutDynCon con getIdPrimRep params
- maybe_offset = assocMaybe params_w_offsets selectee
- Just the_offset = maybe_offset
- offset_into_int_maybe = intOffsetIntoGoods the_offset
- Just offset_into_int = offset_into_int_maybe
- is_single_constructor = maybeToBool (maybeSingleConstructorTyCon tycon)
- (_,_,_, tycon) = getDataConSig con
-\end{code}
-
-Same kind of thing, looking for vector-apply thunks, of the form:
-
- x = [...] \ .. [] -> f a1 .. an
-
-where f has arity n. We rely on the arity info inside the Id being correct.
-
-\begin{code}
-mkClosureLFInfo top_level
- fvs
- upd_flag
- [] -- No args; a thunk
- (StgApp (StgVarArg fun_id) args _)
- | not top_level -- A top-level thunk would require a static
- -- vap_info table, which we don't generate just
- -- now; so top-level thunks are never standard
- -- form.
- && isLocallyDefined fun_id -- Must be defined in this module
- && maybeToBool arity_maybe -- A known function with known arity
- && fun_arity > 0 -- It'd better be a function!
- && fun_arity == length args -- Saturated application
- = LFThunk top_level (null fvs) (isUpdatable upd_flag) (VapThunk fun_id args store_fun_in_vap)
- where
- arity_maybe = arityMaybe (getIdArity fun_id)
- Just fun_arity = arity_maybe
-
- -- If the function is a free variable then it must be stored
- -- in the thunk too; if it isn't a free variable it must be
- -- because it's constant, so it doesn't need to be stored in the thunk
- store_fun_in_vap = fun_id `is_elem` fvs
- is_elem = isIn "mkClosureLFInfo"
-\end{code}
-
-Finally, the general updatable-thing case:
-\begin{code}
-mkClosureLFInfo top fvs upd_flag [] body
+mkClosureLFInfo top fvs upd_flag []
= LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk
isUpdatable ReEntrant = False
mkConLFInfo :: DataCon -> LambdaFormInfo
mkConLFInfo con
- = ASSERT(isDataCon con)
- let
- arity = getDataConArity 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)
+
+mkSelectorLFInfo scrutinee con offset
+ = LFThunk False False True (SelectorThunk scrutinee con offset)
+
+mkVapLFInfo fvs upd_flag fun_id args fun_in_vap
+ = LFThunk False (null fvs) (isUpdatable upd_flag) (VapThunk fun_id args fun_in_vap)
\end{code}
else if maybeToBool (maybeIntLikeTyCon tycon) then IntLikeRep
else SpecRep
where
- tycon = getDataConTyCon con
+ tycon = dataConTyCon con
_ -> SpecRep
in
the result list
\begin{code}
-mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
+mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
-> (a -> PrimRep) -- To be able to grab kinds;
- -- w/ a kind, we can find boxedness
- -> [a] -- Things to make offsets for
- -> (Int, -- *Total* number of words allocated
- Int, -- Number of words allocated for *pointers*
- [(a, VirtualHeapOffset)]) -- Things with their offsets from start of object
- -- in order of increasing offset
+ -- w/ a kind, we can find boxedness
+ -> [a] -- Things to make offsets for
+ -> (Int, -- *Total* number of words allocated
+ Int, -- Number of words allocated for *pointers*
+ [(a, VirtualHeapOffset)])
+ -- Things with their offsets from start of object
+ -- in order of increasing offset
-- First in list gets lowest offset, which is initial offset + 1.
\begin{code}
nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
nodeMustPointToIt lf_info
- = isSwitchSetC SccProfilingOn `thenFC` \ do_profiling ->
-
+ = let
+ do_profiling = opt_SccProfilingOn
+ in
case lf_info of
LFReEntrant top arity no_fvs -> returnFC (
not no_fvs || -- Certainly if it has fvs we need to point to it
-- having Node point to the result of an update. SLPJ
-- 27/11/92.
- LFThunk _ no_fvs updatable _
+ LFThunk _ no_fvs updatable NonStandardThunk
-> returnFC (updatable || not no_fvs || do_profiling)
-- For the non-updatable (single-entry case):
-- or profiling (in which case we need to recover the cost centre
-- from inside it)
+ LFThunk _ no_fvs updatable some_standard_form_thunk
+ -> returnFC True
+ -- Node must point to any standard-form thunk.
+ -- For example,
+ -- x = f y
+ -- generates a Vap thunk for (f y), and even if y is a global
+ -- variable we must still make Node point to the thunk before entering it
+ -- because that's what the standard-form code expects.
+
LFArgument -> returnFC True
LFImported -> returnFC True
LFBlackHole -> returnFC True
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
getEntryConvention id lf_info arg_kinds
= nodeMustPointToIt lf_info `thenFC` \ node_points ->
- isSwitchSetC ForConcurrent `thenFC` \ is_concurrent ->
- getIntSwitchChkrC `thenFC` \ isw_chkr ->
+ let
+ is_concurrent = opt_ForConcurrent
+ in
returnFC (
if (node_points && is_concurrent) then ViaNode else
else
DirectEntry (mkFastEntryLabel id arity) arity arg_regs
where
- (arg_regs, _) = assignRegs isw_chkr live_regs (take arity arg_kinds)
+ (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
live_regs = if node_points then [node] else []
LFCon con zero_arity
-> 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
-> ASSERT(arity == length arg_kinds)
DirectEntry (mkStdEntryLabel id) arity arg_regs
where
- (arg_regs, _) = assignRegs isw_chkr live_regs arg_kinds
+ (arg_regs, _) = assignRegs live_regs arg_kinds
live_regs = if node_points then [node] else []
)
slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
:: Id
-> StgBinderInfo
+ -> EntryConvention
-> Bool
-slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
+slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
= arg_occ -- There's an argument occurrence
|| unsat_occ -- There's an unsaturated call
|| externallyVisibleId binder
- {- HAS FREE VARS AND IS PARALLEL WORLD -}
+ || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
+ {- The last case deals with the parallel world; a function usually
+ as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
-slowFunEntryCodeRequired binder NoStgBinderInfo = True
+slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
funInfoTableRequired
:: Id
_ -> False
\end{code}
+@lfArity@ extracts the arity of a function from its LFInfo
+
+\begin{code}
+{- Not needed any more
+
+lfArity_maybe (LFReEntrant _ arity _) = Just arity
+
+-- 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}
+
%************************************************************************
%* *
\subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
%************************************************************************
\begin{code}
-isConstantRep, isSpecRep, isStaticRep, isPhantomRep, isIntLikeRep :: SMRep -> Bool
-isConstantRep (SpecialisedRep ConstantRep _ _ _) = True
-isConstantRep other = False
-
-isSpecRep (SpecialisedRep kind _ _ _) = True -- All the kinds of Spec closures
-isSpecRep other = False -- True indicates that the _VHS is 0 !
-
-isStaticRep (StaticRep _ _) = True
-isStaticRep _ = False
-
-isPhantomRep PhantomRep = True
-isPhantomRep _ = False
-
-isIntLikeRep (SpecialisedRep IntLikeRep _ _ _) = True
-isIntLikeRep other = False
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
-- rather than take it from the Id. The Id is probably just "f"!
closureType (MkClosureInfo id (LFThunk _ _ _ (VapThunk fun_id args _)) _)
- = getUniDataSpecTyCon_maybe (funResultTy de_foralld_ty (length args))
- where
- (_, de_foralld_ty) = splitForalls (idType fun_id)
+ = maybeAppSpecDataTyConExpandingDicts (fun_result_ty (length args) fun_id)
-closureType (MkClosureInfo id lf _) = getUniDataSpecTyCon_maybe (idType id)
+closureType (MkClosureInfo id lf _) = maybeAppSpecDataTyConExpandingDicts (idType id)
\end{code}
@closureReturnsUnboxedType@ is used to check whether a closure, {\em
closureReturnsUnboxedType :: ClosureInfo -> Bool
closureReturnsUnboxedType (MkClosureInfo fun_id (LFReEntrant _ arity _) _)
- = isPrimType (funResultTy de_foralld_ty arity)
- where
- (_, de_foralld_ty) = splitForalls (idType fun_id)
+ = isPrimType (fun_result_ty arity fun_id)
closureReturnsUnboxedType other_closure = False
-- All non-function closures aren't functions,
-- and hence are boxed, since they are heap alloc'd
+
+-- ToDo: need anything like this in Type.lhs?
+fun_result_ty arity id
+ = let
+ (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:" (hsep [int arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $
+ mkFunTys (drop arity arg_tys) res_ty
\end{code}
\begin{code}
closureSemiTag (MkClosureInfo _ lf_info _)
= case lf_info of
- LFCon data_con _ -> getDataConTag data_con - fIRST_TAG
+ LFCon data_con _ -> dataConTag data_con - fIRST_TAG
LFTuple _ _ -> 0
_ -> 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}
-infoTableLabelFromCI :: ClosureInfo -> CLabel
+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 ->
+-}
+ = case getIdArity id of
+ ArityExactly arity -> mkFastEntryLabel id arity
+ other -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
+infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI (MkClosureInfo id lf_info rep)
= case lf_info of
LFCon con _ -> mkConInfoPtr con 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
+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)
= mkVapEntryLabel fun_id is_updatable
thunkEntryLabel thunk_id _ is_updatable
= mkStdEntryLabel thunk_id
-
-fastLabelFromCI :: ClosureInfo -> CLabel
-fastLabelFromCI (MkClosureInfo id _ _) = mkFastEntryLabel id fun_arity
- where
- arity_maybe = arityMaybe (getIdArity id)
- fun_arity = case arity_maybe of
- Just x -> x
- _ -> pprPanic "fastLabelFromCI:no arity:" (ppr PprShowAll id)
\end{code}
\begin{code}
LFImported -> panic "ALLOC_IMP"
\end{code}
-We need a black-hole closure info to pass to @allocDynClosure@
-when we want to allocate the black hole on entry to a CAF.
+We need a black-hole closure info to pass to @allocDynClosure@ when we
+want to allocate the black hole on entry to a CAF.
\begin{code}
-blackHoleClosureInfo (MkClosureInfo id _ _) = MkClosureInfo id LFBlackHole BlackHoleRep
+blackHoleClosureInfo (MkClosureInfo id _ _)
+ = MkClosureInfo id LFBlackHole BlackHoleRep
\end{code}
-The register liveness when returning from a constructor. For simplicity,
-we claim just [node] is live for all but PhantomRep's. In truth, this means
-that non-constructor info tables also claim node, but since their liveness
-information is never used, we don't care.
+The register liveness when returning from a constructor. For
+simplicity, we claim just [node] is live for all but PhantomRep's. In
+truth, this means that non-constructor info tables also claim node,
+but since their liveness information is never used, we don't care.
\begin{code}
-
-dataConLiveness isw_chkr (MkClosureInfo con _ PhantomRep)
- = case (dataReturnConvAlg isw_chkr con) of
- ReturnInRegs regs -> mkLiveRegsBitMask regs
+dataConLiveness (MkClosureInfo con _ PhantomRep)
+ = case (dataReturnConvAlg con) of
+ ReturnInRegs regs -> mkLiveRegsMask regs
ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
-dataConLiveness _ _ = mkLiveRegsBitMask [node]
+dataConLiveness _ = mkLiveRegsMask [node]
\end{code}
%************************************************************************
closureTypeDescr :: ClosureInfo -> String
closureTypeDescr (MkClosureInfo id lf _)
- = if (isDataCon id) then -- DataCon has function types
- _UNPK_ (getOccurrenceName (getDataConTyCon id)) -- We want the TyCon not the ->
+ = if (isDataCon id) then -- DataCon has function types
+ getOccString (dataConTyCon id) -- We want the TyCon not the ->
else
- getUniTyDescription (idType id)
+ getTyDescription (idType id)
\end{code}
-
projects / ghc-hetmet.git / blobdiff