X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FClosureInfo.lhs;h=0abf831c5169148ddac86988bc8cf8d1bec1e9f4;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=b7e6acedb73b862f33793c9aca2d7e95c8c6081b;hpb=685e04e4af2e2332f2555990122596c7931cb543;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index b7e6ace..0abf831 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -1,9 +1,11 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% (c) The Univserity of Glasgow 1992-2004 % -% $Id: ClosureInfo.lhs,v 1.49 2001/10/18 16:29:13 simonpj Exp $ -% -\section[ClosureInfo]{Data structures which describe closures} + + Data structures which describe closures, and + operations over those data structures + + Nothing monadic in here Much of the rationale for these things is in the ``details'' part of the STG paper. @@ -11,104 +13,119 @@ the STG paper. \begin{code} module ClosureInfo ( ClosureInfo, LambdaFormInfo, SMRep, -- all abstract - StandardFormInfo, + StandardFormInfo, - EntryConvention(..), + ArgDescr(..), Liveness(..), + C_SRT(..), needsSRT, - mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, + mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, - UpdateFlag, + + mkClosureInfo, mkConInfo, closureSize, closureNonHdrSize, closureGoodStuffSize, closurePtrsSize, - slopSize, + slopSize, + + closureName, infoTableLabelFromCI, + closureLabelFromCI, closureSRT, + closureLFInfo, closureSMRep, closureUpdReqd, + closureSingleEntry, closureReEntrant, isConstrClosure_maybe, + closureFunInfo, isStandardFormThunk, isKnownFun, - layOutDynClosure, layOutDynConstr, layOutStaticClosure, - layOutStaticNoFVClosure, layOutStaticConstr, - mkVirtHeapOffsets, + enterIdLabel, enterReturnPtLabel, - nodeMustPointToIt, getEntryConvention, - FCode, CgInfoDownwards, CgState, + nodeMustPointToIt, + CallMethod(..), getCallMethod, blackHoleOnEntry, staticClosureRequired, - slowFunEntryCodeRequired, funInfoTableRequired, - - closureName, infoTableLabelFromCI, fastLabelFromCI, - closureLabelFromCI, closureSRT, - entryLabelFromCI, - closureLFInfo, closureSMRep, closureUpdReqd, - closureSingleEntry, closureReEntrant, closureSemiTag, - isStandardFormThunk, - GenStgArg, + getClosureType, isToplevClosure, - closureTypeDescr, -- profiling + closureValDescr, closureTypeDescr, -- profiling isStaticClosure, - allocProfilingMsg, cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo, - maybeSelectorInfo, staticClosureNeedsLink, ) where +#include "../includes/MachDeps.h" #include "HsVersions.h" -import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset, C_SRT(..), needsSRT ) import StgSyn -import CgMonad - -import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject, - mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE ) -import CgRetConv ( assignRegs ) -import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel, - mkInfoTableLabel, - mkConInfoTableLabel, - mkCAFBlackHoleInfoTableLabel, - mkSECAFBlackHoleInfoTableLabel, - mkStaticInfoTableLabel, mkStaticConEntryLabel, - mkConEntryLabel, mkClosureLabel, - mkSelectorInfoLabel, mkSelectorEntryLabel, - mkApInfoTableLabel, mkApEntryLabel, - mkReturnPtLabel - ) +import SMRep -- all of it + +import CLabel + +import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject ) import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling, opt_Parallel, opt_DoTickyProfiling, opt_SMP ) -import Id ( Id, idType, idArity ) -import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon, - isNullaryDataCon, dataConName - ) -import TyCon ( isBoxedTupleTyCon ) -import Name ( Name, nameUnique, getOccName ) +import Id ( Id, idType, idArity, idName ) +import DataCon ( DataCon, dataConTyCon, isNullaryDataCon, dataConName ) +import Name ( Name, nameUnique, getOccName, getOccString ) import OccName ( occNameUserString ) -import PprType ( getTyDescription ) -import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep ) -import SMRep -- all of it -import Type ( isUnLiftedType, Type ) -import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel ) -import Util ( mapAccumL ) +import Type ( isUnLiftedType, Type, repType, splitTyConApp_maybe ) +import TcType ( tcSplitSigmaTy ) +import TyCon ( isFunTyCon, isAbstractTyCon ) +import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName ) +import FastString import Outputable +import Constants + +import TypeRep -- TEMP \end{code} + %************************************************************************ %* * \subsection[ClosureInfo-datatypes]{Data types for closure information} %* * %************************************************************************ -The ``wrapper'' data type for closure information: +Information about a closure, from the code generator's point of view. + +A ClosureInfo decribes the info pointer of a closure. It has +enough information + a) to construct the info table itself + b) to allocate a closure containing that info pointer (i.e. + it knows the info table label) + +We make a ClosureInfo for + - each let binding (both top level and not) + - each data constructor (for its shared static and + dynamic info tables) \begin{code} data ClosureInfo - = MkClosureInfo { - closureName :: Name, -- The thing bound to this closure - closureLFInfo :: LambdaFormInfo, -- Info derivable from the *source* - closureSMRep :: SMRep, -- representation used by storage manager - closureSRT :: C_SRT -- What SRT applies to this closure + = ClosureInfo { + closureName :: !Name, -- The thing bound to this closure + closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below) + closureSMRep :: !SMRep, -- representation used by storage mgr + closureSRT :: !C_SRT, -- What SRT applies to this closure + closureType :: !Type, -- Type of closure (ToDo: remove) + closureDescr :: !String -- closure description (for profiling) + } + + -- Constructor closures don't have a unique info table label (they use + -- the constructor's info table), and they don't have an SRT. + | ConInfo { + closureCon :: !DataCon, + closureSMRep :: !SMRep } + +-- C_SRT is what StgSyn.SRT gets translated to... +-- we add a label for the table, and expect only the 'offset/length' form + +data C_SRT = NoC_SRT + | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-} + +needsSRT :: C_SRT -> Bool +needsSRT NoC_SRT = False +needsSRT (C_SRT _ _ _) = True \end{code} %************************************************************************ @@ -117,41 +134,43 @@ data ClosureInfo %* * %************************************************************************ +Information about an identifier, from the code generator's point of +view. Every identifier is bound to a LambdaFormInfo in the +environment, which gives the code generator enough info to be able to +tail call or return that identifier. + +Note that a closure is usually bound to an identifier, so a +ClosureInfo contains a LambdaFormInfo. + \begin{code} data LambdaFormInfo - = LFReEntrant -- Reentrant closure; used for PAPs too - Type -- Type of closure (ToDo: remove) + = LFReEntrant -- Reentrant closure (a function) TopLevelFlag -- True if top level - !Int -- Arity + !Int -- Arity. Invariant: always > 0 !Bool -- True <=> no fvs + ArgDescr -- Argument descriptor (should reall be in ClosureInfo) - | LFCon -- Constructor + | LFCon -- A saturated constructor application DataCon -- The constructor - Bool -- True <=> zero arity - - | LFTuple -- Tuples - DataCon -- The tuple constructor - Bool -- True <=> zero arity | LFThunk -- Thunk (zero arity) - Type -- Type of the thunk (ToDo: remove) TopLevelFlag !Bool -- True <=> no free vars - Bool -- True <=> updatable (i.e., *not* single-entry) + !Bool -- True <=> updatable (i.e., *not* single-entry) StandardFormInfo + !Bool -- True <=> *might* be a function type - | LFArgument -- Used for function arguments. We know nothing about - -- this closure. Treat like updatable "LFThunk"... - - | LFImported -- Used for imported things. We know nothing about this - -- closure. Treat like updatable "LFThunk"... + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. Treat like + -- updatable "LFThunk"... -- Imported things which we do know something about use -- one of the other LF constructors (eg LFReEntrant for -- known functions) + !Bool -- True <=> *might* be a function type | LFLetNoEscape -- See LetNoEscape module for precise description of -- these "lets". - Int -- arity; + !Int -- arity; | LFBlackHole -- Used for the closures allocated to hold the result -- of a CAF. We want the target of the update frame to @@ -159,36 +178,58 @@ data LambdaFormInfo CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info). -data StandardFormInfo -- Tells whether this thunk has one of a small number - -- of standard forms +------------------------- +-- An ArgDsecr describes the argument pattern of a function - = NonStandardThunk -- No, it isn't +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... - | SelectorThunk - Int -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) + | ArgGen -- General case + Liveness -- Details about the arguments -{- A SelectorThunk is of form - case x of - con a1,..,an -> ak +------------------------- +-- We represent liveness bitmaps as a Bitmap (whose internal +-- representation really is a bitmap). These are pinned onto case return +-- vectors to indicate the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single +-- word (StgWord) are stored as a single word, while larger bitmaps are +-- stored as a pointer to an array of words. - and the constructor is from a single-constr type. --} +data Liveness + = SmallLiveness -- Liveness info that fits in one word + StgWord -- Here's the bitmap - | ApThunk - Int -- arity + | BigLiveness -- Liveness info witha a multi-word bitmap + CLabel -- Label for the bitmap -{- An ApThunk is of form - x1 ... xn +------------------------- +-- StandardFormInfo tells whether this thunk has one of +-- a small number of standard forms - The code for the thunk just pushes x2..xn on the stack and enters x1. - There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - in the RTS to save space. --} +data StandardFormInfo + = NonStandardThunk + -- Not of of the standard forms + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + Int -- Arity, n \end{code} %************************************************************************ @@ -197,61 +238,95 @@ data StandardFormInfo -- Tells whether this thunk has one of a small number %* * %************************************************************************ -@mkClosureLFInfo@ figures out the appropriate LFInfo for the closure. - \begin{code} -mkClosureLFInfo :: Id -- The binder - -> TopLevelFlag -- True of top level - -> [Id] -- Free vars - -> UpdateFlag -- Update flag - -> [Id] -- Args - -> LambdaFormInfo - -mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args - = LFReEntrant (idType bndr) top (length args) (null fvs) - -mkClosureLFInfo bndr top fvs ReEntrant [] - = LFReEntrant (idType bndr) top 0 (null fvs) - -mkClosureLFInfo bndr top fvs upd_flag [] -#ifdef DEBUG - | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty) -#endif - | otherwise - = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk - where - ty = idType bndr +mkLFReEntrant :: TopLevelFlag -- True of top level + -> [Id] -- Free vars + -> [Id] -- Args + -> ArgDescr -- Argument descriptor + -> LambdaFormInfo + +mkLFReEntrant top fvs args arg_descr + = LFReEntrant top (length args) (null fvs) arg_descr + +mkLFThunk thunk_ty top fvs upd_flag + = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) ) + LFThunk top (null fvs) + (isUpdatable upd_flag) + NonStandardThunk + (might_be_a_function thunk_ty) + +might_be_a_function :: Type -> Bool +might_be_a_function ty + | Just (tc,_) <- splitTyConApp_maybe (repType ty), + not (isFunTyCon tc) && not (isAbstractTyCon tc) = False + -- don't forget to check for abstract types, which might + -- be functions too. + | otherwise = True \end{code} @mkConLFInfo@ is similar, for constructors. \begin{code} mkConLFInfo :: DataCon -> LambdaFormInfo +mkConLFInfo con = LFCon con -mkConLFInfo con - = -- the isNullaryDataCon will do this: ASSERT(isDataCon con) - (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon) - con (isNullaryDataCon con) - -mkSelectorLFInfo rhs_ty offset updatable - = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset) +mkSelectorLFInfo id offset updatable + = LFThunk NotTopLevel False updatable (SelectorThunk offset) + (might_be_a_function (idType id)) -mkApLFInfo rhs_ty upd_flag arity - = LFThunk rhs_ty NotTopLevel (arity == 0) - (isUpdatable upd_flag) (ApThunk arity) +mkApLFInfo id upd_flag arity + = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) + (might_be_a_function (idType id)) \end{code} Miscellaneous LF-infos. \begin{code} -mkLFArgument = LFArgument +mkLFArgument id = LFUnknown (might_be_a_function (idType id)) + mkLFLetNoEscape = LFLetNoEscape mkLFImported :: Id -> LambdaFormInfo mkLFImported id = case idArity id of - n | n > 0 -> LFReEntrant (idType id) TopLevel n True -- n > 0 - other -> LFImported -- Not sure of exact arity + n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0 + other -> mkLFArgument id -- Not sure of exact arity +\end{code} + +%************************************************************************ +%* * + Building ClosureInfos +%* * +%************************************************************************ + +\begin{code} +mkClosureInfo :: Bool -- Is static + -> Id + -> LambdaFormInfo + -> Int -> Int -- Total and pointer words + -> C_SRT + -> String -- String descriptor + -> ClosureInfo +mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr + = ClosureInfo { closureName = name, + closureLFInfo = lf_info, + closureSMRep = sm_rep, + closureSRT = srt_info, + closureType = idType id, + closureDescr = descr } + where + name = idName id + sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds + +mkConInfo :: Bool -- Is static + -> DataCon + -> Int -> Int -- Total and pointer words + -> ClosureInfo +mkConInfo is_static data_con tot_wds ptr_wds + = ConInfo { closureSMRep = sm_rep, + closureCon = data_con } + where + sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds \end{code} %************************************************************************ @@ -261,35 +336,43 @@ mkLFImported id %************************************************************************ \begin{code} -closureSize :: ClosureInfo -> HeapOffset +closureSize :: ClosureInfo -> WordOff closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info -closureNonHdrSize :: ClosureInfo -> Int +closureNonHdrSize :: ClosureInfo -> WordOff closureNonHdrSize cl_info = tot_wds + computeSlopSize tot_wds (closureSMRep cl_info) - (closureUpdReqd cl_info) + (closureNeedsUpdSpace cl_info) where tot_wds = closureGoodStuffSize cl_info -slopSize :: ClosureInfo -> Int +-- we leave space for an update if either (a) the closure is updatable +-- or (b) it is a static thunk. This is because a static thunk needs +-- a static link field in a predictable place (after the slop), regardless +-- of whether it is updatable or not. +closureNeedsUpdSpace (ClosureInfo { closureLFInfo = + LFThunk TopLevel _ _ _ _ }) = True +closureNeedsUpdSpace cl_info = closureUpdReqd cl_info + +slopSize :: ClosureInfo -> WordOff slopSize cl_info = computeSlopSize (closureGoodStuffSize cl_info) (closureSMRep cl_info) - (closureUpdReqd cl_info) + (closureNeedsUpdSpace cl_info) -closureGoodStuffSize :: ClosureInfo -> Int +closureGoodStuffSize :: ClosureInfo -> WordOff closureGoodStuffSize cl_info = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info) in ptrs + nonptrs -closurePtrsSize :: ClosureInfo -> Int +closurePtrsSize :: ClosureInfo -> WordOff closurePtrsSize cl_info = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info) in ptrs -- not exported: -sizes_from_SMRep :: SMRep -> (Int,Int) +sizes_from_SMRep :: SMRep -> (WordOff,WordOff) sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs) sizes_from_SMRep BlackHoleRep = (0, 0) \end{code} @@ -323,7 +406,7 @@ Static closures have an extra ``static link field'' at the end, but we don't bother taking that into account here. \begin{code} -computeSlopSize :: Int -> SMRep -> Bool -> Int +computeSlopSize :: WordOff -> SMRep -> Bool -> WordOff computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable = max 0 (mIN_UPD_SIZE - tot_wds) @@ -340,175 +423,38 @@ computeSlopSize tot_wds BlackHoleRep _ -- Updatable %************************************************************************ %* * -\subsection[layOutDynClosure]{Lay out a dynamic closure} -%* * -%************************************************************************ - -\begin{code} -layOutDynClosure, layOutStaticClosure - :: Name -- STG identifier of this closure - -> (a -> PrimRep) -- how to get a PrimRep for the fields - -> [a] -- the "things" being layed out - -> LambdaFormInfo -- what sort of closure it is - -> C_SRT - -> (ClosureInfo, -- info about the closure - [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them - -layOutDynClosure name kind_fn things lf_info srt_info - = (MkClosureInfo { closureName = name, closureLFInfo = lf_info, - closureSMRep = sm_rep, closureSRT = srt_info }, - things_w_offsets) - where - (tot_wds, -- #ptr_wds + #nonptr_wds - ptr_wds, -- #ptr_wds - things_w_offsets) = mkVirtHeapOffsets kind_fn things - sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds -\end{code} - -Wrappers for when used with data constructors: - -\begin{code} -layOutDynConstr, layOutStaticConstr - :: Name -- Of the closure - -> DataCon - -> (a -> PrimRep) -> [a] - -> (ClosureInfo, [(a,VirtualHeapOffset)]) - -layOutDynConstr name data_con kind_fn args - = layOutDynClosure name kind_fn args (mkConLFInfo data_con) NoC_SRT - -layOutStaticConstr name data_con kind_fn things - = layOutStaticClosure name kind_fn things (mkConLFInfo data_con) NoC_SRT -\end{code} - -%************************************************************************ -%* * -\subsection[layOutStaticClosure]{Lay out a static closure} -%* * -%************************************************************************ - -layOutStaticClosure is only used for laying out static constructors at -the moment. - -Static closures for functions are laid out using -layOutStaticNoFVClosure. - -\begin{code} -layOutStaticClosure name kind_fn things lf_info srt_info - = (MkClosureInfo { closureName = name, closureLFInfo = lf_info, - closureSMRep = rep, closureSRT = srt_info }, - things_w_offsets) - where - rep = GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type - - (tot_wds, -- #ptr_wds + #nonptr_wds - ptr_wds, -- #ptr_wds - things_w_offsets) = mkVirtHeapOffsets kind_fn things - - -- constructors with no pointer fields will definitely be NOCAF things. - -- this is a compromise until we can generate both kinds of constructor - -- (a normal static kind and the NOCAF_STATIC kind). - closure_type = getClosureType is_static tot_wds ptr_wds lf_info - is_static = True - -layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> C_SRT -> ClosureInfo -layOutStaticNoFVClosure name lf_info srt_info - = MkClosureInfo { closureName = name, closureLFInfo = lf_info, - closureSMRep = rep, closureSRT = srt_info } - where - rep = GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info) - is_static = True -\end{code} - -%************************************************************************ -%* * \subsection[SMreps]{Choosing SM reps} %* * %************************************************************************ \begin{code} -chooseDynSMRep - :: LambdaFormInfo - -> Int -> Int -- Tot wds, ptr wds +chooseSMRep + :: Bool -- True <=> static closure + -> LambdaFormInfo + -> WordOff -> WordOff -- Tot wds, ptr wds -> SMRep -chooseDynSMRep lf_info tot_wds ptr_wds +chooseSMRep is_static lf_info tot_wds ptr_wds = let - is_static = False nonptr_wds = tot_wds - ptr_wds - closure_type = getClosureType is_static tot_wds ptr_wds lf_info + closure_type = getClosureType is_static ptr_wds lf_info in GenericRep is_static ptr_wds nonptr_wds closure_type --- we *do* get non-updatable top-level thunks sometimes. eg. f = g +-- We *do* get non-updatable top-level thunks sometimes. eg. f = g -- gets compiled to a jump to g (if g has non-zero arity), instead of -- messing around with update frames and PAPs. We set the closure type -- to FUN_STATIC in this case. -getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType -getClosureType is_static tot_wds ptr_wds lf_info +getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType +getClosureType is_static ptr_wds lf_info = case lf_info of - LFCon con zero_arity - | is_static && ptr_wds == 0 -> CONSTR_NOCAF - | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n - | otherwise -> CONSTR - - LFTuple _ zero_arity - | is_static && ptr_wds == 0 -> CONSTR_NOCAF - | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n - | otherwise -> CONSTR - - LFReEntrant _ _ _ _ - | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n - | otherwise -> FUN - - LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR - - LFThunk _ _ _ _ _ - | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n - | otherwise -> THUNK - + LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf + | otherwise -> Constr + LFReEntrant _ _ _ _ -> Fun + LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector + LFThunk _ _ _ _ _ -> Thunk _ -> panic "getClosureType" - where - specialised_rep max_size = not is_static - && tot_wds > 0 - && tot_wds <= max_size -\end{code} - -%************************************************************************ -%* * -\subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure} -%* * -%************************************************************************ - -@mkVirtHeapOffsets@ (the heap version) always returns boxed things with -smaller offsets than the unboxed things, and furthermore, the offsets in -the result list - -\begin{code} -mkVirtHeapOffsets :: - (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 - --- First in list gets lowest offset, which is initial offset + 1. - -mkVirtHeapOffsets kind_fun things - = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things - (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs - (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs - in - (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets) - where - computeOffset wds_so_far thing - = (wds_so_far + (getPrimRepSize . kind_fun) thing, - (thing, fixedHdrSize + wds_so_far) - ) \end{code} %************************************************************************ @@ -520,13 +466,10 @@ mkVirtHeapOffsets kind_fun things Be sure to see the stg-details notes about these... \begin{code} -nodeMustPointToIt :: LambdaFormInfo -> FCode Bool -nodeMustPointToIt lf_info - - = case lf_info of - LFReEntrant ty top arity no_fvs -> returnFC ( - not no_fvs || -- Certainly if it has fvs we need to point to it - isNotTopLevel top +nodeMustPointToIt :: LambdaFormInfo -> Bool +nodeMustPointToIt (LFReEntrant top _ no_fvs _) + = not no_fvs || -- Certainly if it has fvs we need to point to it + isNotTopLevel top -- If it is not top level we will point to it -- We can have a \r closure with no_fvs which -- is not top level as special case cgRhsClosure @@ -535,10 +478,8 @@ nodeMustPointToIt lf_info -- For lex_profiling we also access the cost centre for a -- non-inherited function i.e. not top level -- the not top case above ensures this is ok. - ) - LFCon _ zero_arity -> returnFC True - LFTuple _ zero_arity -> returnFC True +nodeMustPointToIt (LFCon _) = True -- Strictly speaking, the above two don't need Node to point -- to it if the arity = 0. But this is a *really* unlikely @@ -551,9 +492,8 @@ nodeMustPointToIt lf_info -- having Node point to the result of an update. SLPJ -- 27/11/92. - LFThunk _ _ no_fvs updatable NonStandardThunk - -> returnFC (updatable || not no_fvs || opt_SccProfilingOn) - +nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _) + = updatable || not no_fvs || opt_SccProfilingOn -- For the non-updatable (single-entry case): -- -- True if has fvs (in which case we need access to them, and we @@ -561,16 +501,12 @@ nodeMustPointToIt lf_info -- 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. - - LFArgument -> returnFC True - LFImported -> returnFC True - LFBlackHole _ -> returnFC True - -- BH entry may require Node to point +nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _) + = True -- Node must point to any standard-form thunk - LFLetNoEscape _ -> returnFC False +nodeMustPointToIt (LFUnknown _) = True +nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point +nodeMustPointToIt (LFLetNoEscape _) = False \end{code} The entry conventions depend on the type of closure being entered, @@ -602,107 +538,98 @@ When black-holing, single-entry closures could also be entered via node (rather than directly) to catch double-entry. \begin{code} -data EntryConvention - = ViaNode -- The "normal" convention +data CallMethod + = EnterIt -- no args, not a function + + | JumpToIt CLabel -- no args, not a function, but we + -- know what its entry code is + + | ReturnIt -- it's a function, but we have + -- zero args to apply to it, so just + -- return it. + + | ReturnCon DataCon -- It's a data constructor, just return it - | StdEntry CLabel -- Jump to this code, with args on stack + | SlowCall -- Unknown fun, or known fun with + -- too few args. | DirectEntry -- Jump directly, with args in regs CLabel -- The code label Int -- Its arity - [MagicId] -- Its register assignments - -- (possibly empty) - -getEntryConvention :: Name -- Function being applied - -> LambdaFormInfo -- Its info - -> [PrimRep] -- Available arguments - -> FCode EntryConvention - -getEntryConvention name lf_info arg_kinds - = nodeMustPointToIt lf_info `thenFC` \ node_points -> - returnFC ( - - -- if we're parallel, then we must always enter via node. The reason - -- is that the closure may have been fetched since we allocated it. - - if (node_points && opt_Parallel) then ViaNode else - - -- Commented out by SDM after futher thoughts: - -- - the only closure type that can be blackholed is a thunk - -- - we already enter thunks via node (unless the closure is - -- non-updatable, in which case why is it being re-entered...) - - case lf_info of - - LFReEntrant _ _ arity _ -> - if arity == 0 || (length arg_kinds) < arity then - StdEntry (mkStdEntryLabel name) - else - DirectEntry (mkFastEntryLabel name arity) arity arg_regs - where - (arg_regs, _) = assignRegs live_regs (take arity arg_kinds) - live_regs = if node_points then [node] else [] - - LFCon con True{-zero_arity-} - -- a real constructor. Don't bother entering it, just jump - -- to the constructor entry code directly. - -> --false:ASSERT (null arg_kinds) - -- Should have no args (meaning what?) - StdEntry (mkStaticConEntryLabel (dataConName con)) - - LFCon con False{-non-zero_arity-} - -> --false:ASSERT (null arg_kinds) - -- Should have no args (meaning what?) - StdEntry (mkConEntryLabel (dataConName con)) - - LFTuple tup zero_arity - -> --false:ASSERT (null arg_kinds) - -- Should have no args (meaning what?) - StdEntry (mkConEntryLabel (dataConName tup)) - - LFThunk _ _ _ updatable std_form_info - -> if updatable || opt_DoTickyProfiling -- to catch double entry - || opt_SMP -- always enter via node on SMP, since the + +getCallMethod :: Name -- Function being applied + -> LambdaFormInfo -- Its info + -> Int -- Number of available arguments + -> CallMethod + +getCallMethod name lf_info n_args + | nodeMustPointToIt lf_info && opt_Parallel + = -- If we're parallel, then we must always enter via node. + -- The reason is that the closure may have been + -- fetched since we allocated it. + EnterIt + +getCallMethod name (LFReEntrant _ arity _ _) n_args + | n_args == 0 = ASSERT( arity /= 0 ) + ReturnIt -- No args at all + | n_args < arity = SlowCall -- Not enough args + | otherwise = DirectEntry (enterIdLabel name) arity + +getCallMethod name (LFCon con) n_args + = ASSERT( n_args == 0 ) + ReturnCon con + +getCallMethod name (LFThunk _ _ updatable std_form_info is_fun) n_args + | is_fun -- Must always "call" a function-typed + = SlowCall -- thing, cannot just enter it [in eval/apply, the entry code + -- is the fast-entry code] + + | updatable || opt_DoTickyProfiling -- to catch double entry + || opt_SMP -- Always enter via node on SMP, since the -- thunk might have been blackholed in the -- meantime. - then ViaNode - else StdEntry (thunkEntryLabel name std_form_info updatable) - - LFArgument -> ViaNode - LFImported -> ViaNode - LFBlackHole _ -> ViaNode -- Presumably the black hole has by now - -- been updated, but we don't know with - -- what, so we enter via Node - - LFLetNoEscape 0 - -> StdEntry (mkReturnPtLabel (nameUnique name)) - - LFLetNoEscape arity - -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else - DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs - where - (arg_regs, _) = assignRegs [] arg_kinds - -- node never points to a LetNoEscape, see above --SDM - --live_regs = if node_points then [node] else [] - ) + = ASSERT( n_args == 0 ) EnterIt -blackHoleOnEntry :: ClosureInfo -> Bool + | otherwise -- Jump direct to code for single-entry thunks + = ASSERT( n_args == 0 ) + JumpToIt (thunkEntryLabel name std_form_info updatable) + +getCallMethod name (LFUnknown True) n_args + = SlowCall -- might be a function + +getCallMethod name (LFUnknown False) n_args + = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) + EnterIt -- Not a function + +getCallMethod name (LFBlackHole _) n_args + = SlowCall -- Presumably the black hole has by now + -- been updated, but we don't know with + -- what, so we slow call it +getCallMethod name (LFLetNoEscape 0) n_args + = JumpToIt (enterReturnPtLabel (nameUnique name)) + +getCallMethod name (LFLetNoEscape arity) n_args + | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity + | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity) + +blackHoleOnEntry :: ClosureInfo -> Bool -- Static closures are never themselves black-holed. -- Updatable ones will be overwritten with a CAFList cell, which points to a -- black hole; -- Single-entry ones have no fvs to plug, and we trust they don't form part -- of a loop. -blackHoleOnEntry cl_info - | isStaticRep (closureSMRep cl_info) +blackHoleOnEntry ConInfo{} = False +blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) + | isStaticRep rep = False -- Never black-hole a static closure | otherwise - = case closureLFInfo cl_info of + = case lf_info of LFReEntrant _ _ _ _ -> False LFLetNoEscape _ -> False - LFThunk _ _ no_fvs updatable _ + LFThunk _ no_fvs updatable _ _ -> if updatable then not opt_OmitBlackHoling else opt_DoTickyProfiling || not no_fvs @@ -712,14 +639,14 @@ blackHoleOnEntry cl_info other -> panic "blackHoleOnEntry" -- Should never happen isStandardFormThunk :: LambdaFormInfo -> Bool - -isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _)) = True -isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _)) = True +isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True +isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True isStandardFormThunk other_lf_info = False -maybeSelectorInfo (MkClosureInfo { closureLFInfo = LFThunk _ _ _ _ (SelectorThunk offset) }) - = Just offset -maybeSelectorInfo _ = Nothing +isKnownFun :: LambdaFormInfo -> Bool +isKnownFun (LFReEntrant _ _ _ _) = True +isKnownFun (LFLetNoEscape _) = True +isKnownFun _ = False \end{code} ----------------------------------------------------------------------------- @@ -730,19 +657,18 @@ staticClosureNeedsLink :: ClosureInfo -> Bool -- A static closure needs a link field to aid the GC when traversing -- the static closure graph. But it only needs such a field if either -- a) it has an SRT --- b) it's a non-nullary constructor +-- b) it's a constructor with one or more pointer fields -- In case (b), the constructor's fields themselves play the role -- of the SRT. -staticClosureNeedsLink (MkClosureInfo { closureName = name, closureSRT = srt, closureLFInfo = info }) - = needsSRT srt || constructor_srt +staticClosureNeedsLink (ClosureInfo { closureSRT = srt }) + = needsSRT srt +staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con }) + = not (isNullaryDataCon con) && not_nocaf_constr where - constructor_srt - = case info of - LFThunk _ _ _ _ _ -> False - LFReEntrant _ _ _ _ -> False - LFCon _ is_nullary -> not is_nullary - LFTuple _ is_nullary -> not is_nullary - other -> pprPanic "staticClosureNeedsLink" (ppr name) + not_nocaf_constr = + case sm_rep of + GenericRep _ _ _ ConstrNoCaf -> False + _other -> True \end{code} Avoiding generating entries and info tables @@ -813,34 +739,12 @@ staticClosureRequired -> LambdaFormInfo -> Bool staticClosureRequired binder bndr_info - (LFReEntrant _ top_level _ _) -- It's a function + (LFReEntrant top_level _ _ _) -- It's a function = ASSERT( isTopLevel top_level ) -- Assumption: it's a top-level, no-free-var binding not (satCallsOnly bndr_info) staticClosureRequired binder other_binder_info other_lf_info = True - -slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk. - :: Name - -> StgBinderInfo - -> EntryConvention - -> Bool -slowFunEntryCodeRequired binder bndr_info entry_conv - = not (satCallsOnly bndr_info) - || (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 -} - -funInfoTableRequired - :: Name - -> StgBinderInfo - -> LambdaFormInfo - -> Bool -funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _) - = isNotTopLevel top_level - || not (satCallsOnly bndr_info) - -funInfoTableRequired other_binder_info binder other_lf_info = True \end{code} %************************************************************************ @@ -855,67 +759,66 @@ isStaticClosure :: ClosureInfo -> Bool isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) closureUpdReqd :: ClosureInfo -> Bool -closureUpdReqd (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = upd -closureUpdReqd (MkClosureInfo { closureLFInfo = LFBlackHole _ }) = True +closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd +closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True -- Black-hole closures are allocated to receive the results of an -- alg case with a named default... so they need to be updated. closureUpdReqd other_closure = False closureSingleEntry :: ClosureInfo -> Bool -closureSingleEntry (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = not upd +closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd closureSingleEntry other_closure = False closureReEntrant :: ClosureInfo -> Bool -closureReEntrant (MkClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True +closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True closureReEntrant other_closure = False -\end{code} -\begin{code} -closureSemiTag :: ClosureInfo -> Maybe Int -closureSemiTag (MkClosureInfo { closureLFInfo = lf_info }) - = case lf_info of - LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG) - LFTuple _ _ -> Just 0 - _ -> Nothing +isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon +isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con +isConstrClosure_maybe _ = Nothing + +closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr) +closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc}) + = Just (arity, arg_desc) +closureFunInfo _ + = Nothing \end{code} \begin{code} isToplevClosure :: ClosureInfo -> Bool - -isToplevClosure (MkClosureInfo { closureLFInfo = lf_info }) +isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) = case lf_info of - LFReEntrant _ TopLevel _ _ -> True - LFThunk _ TopLevel _ _ _ -> True + LFReEntrant TopLevel _ _ _ -> True + LFThunk TopLevel _ _ _ _ -> True other -> False +isToplevClosure _ = False \end{code} Label generation. \begin{code} -fastLabelFromCI :: ClosureInfo -> CLabel -fastLabelFromCI (MkClosureInfo { closureName = name, closureLFInfo = LFReEntrant _ _ arity _ }) - = mkFastEntryLabel name arity - -fastLabelFromCI cl_info - = pprPanic "fastLabelFromCI" (ppr (closureName cl_info)) - infoTableLabelFromCI :: ClosureInfo -> CLabel -infoTableLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep }) +infoTableLabelFromCI (ClosureInfo { closureName = name, + closureLFInfo = lf_info, + closureSMRep = rep }) = case lf_info of - LFCon con _ -> mkConInfoPtr con rep - LFTuple tup _ -> mkConInfoPtr tup rep - LFBlackHole info -> info - LFThunk _ _ _ upd_flag (SelectorThunk offset) -> + LFThunk _ _ upd_flag (SelectorThunk offset) _ -> mkSelectorInfoLabel upd_flag offset - LFThunk _ _ _ upd_flag (ApThunk arity) -> + LFThunk _ _ upd_flag (ApThunk arity) _ -> mkApInfoTableLabel upd_flag arity - other -> {-NO: if isStaticRep rep - then mkStaticInfoTableLabel id - else -} mkInfoTableLabel id + LFThunk{} -> mkInfoTableLabel name + + LFReEntrant _ _ _ _ -> mkInfoTableLabel name + + other -> panic "infoTableLabelFromCI" + +infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep }) + = mkConInfoPtr con rep + mkConInfoPtr :: DataCon -> SMRep -> CLabel mkConInfoPtr con rep @@ -924,63 +827,62 @@ mkConInfoPtr con rep where name = dataConName con -mkConEntryPtr :: DataCon -> SMRep -> CLabel -mkConEntryPtr con rep - | isStaticRep rep = mkStaticConEntryLabel (dataConName con) - | otherwise = mkConEntryLabel (dataConName con) - -closureLabelFromCI cl_info = mkClosureLabel (closureName cl_info) - -entryLabelFromCI :: ClosureInfo -> CLabel -entryLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep }) - = case lf_info of - LFThunk _ _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag - LFCon con _ -> mkConEntryPtr con rep - LFTuple tup _ -> mkConEntryPtr tup rep - other -> mkStdEntryLabel id +closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm +closureLabelFromCI _ = panic "closureLabelFromCI" -- thunkEntryLabel is a local help function, not exported. It's used from both --- entryLabelFromCI and getEntryConvention. +-- entryLabelFromCI and getCallMethod. thunkEntryLabel thunk_id (ApThunk arity) is_updatable - = mkApEntryLabel is_updatable arity + = enterApLabel is_updatable arity thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag - = mkSelectorEntryLabel upd_flag offset + = enterSelectorLabel upd_flag offset thunkEntryLabel thunk_id _ is_updatable - = mkStdEntryLabel thunk_id -\end{code} + = enterIdLabel thunk_id -\begin{code} -allocProfilingMsg :: ClosureInfo -> FAST_STRING - -allocProfilingMsg cl_info - = case closureLFInfo cl_info of - LFReEntrant _ _ _ _ -> SLIT("TICK_ALLOC_FUN") - LFCon _ _ -> SLIT("TICK_ALLOC_CON") - LFTuple _ _ -> SLIT("TICK_ALLOC_CON") - LFThunk _ _ _ True _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable - LFThunk _ _ _ False _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable - LFBlackHole _ -> SLIT("TICK_ALLOC_BH") - LFImported -> panic "TICK_ALLOC_IMP" +enterApLabel is_updatable arity + | tablesNextToCode = mkApInfoTableLabel is_updatable arity + | otherwise = mkApEntryLabel is_updatable arity + +enterSelectorLabel upd_flag offset + | tablesNextToCode = mkSelectorInfoLabel upd_flag offset + | otherwise = mkSelectorEntryLabel upd_flag offset + +enterIdLabel id + | tablesNextToCode = mkInfoTableLabel id + | otherwise = mkEntryLabel id + +enterReturnPtLabel name + | tablesNextToCode = mkReturnInfoLabel name + | otherwise = mkReturnPtLabel name \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. These are the only ways to build an LFBlackHole, maintaining the invariant that it really is a black hole and not something else. \begin{code} -cafBlackHoleClosureInfo cl_info - = MkClosureInfo { closureName = closureName cl_info, - closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel, - closureSMRep = BlackHoleRep, - closureSRT = NoC_SRT } - -seCafBlackHoleClosureInfo cl_info - = MkClosureInfo { closureName = closureName cl_info, - closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel, - closureSMRep = BlackHoleRep, - closureSRT = NoC_SRT } +cafBlackHoleClosureInfo (ClosureInfo { closureName = nm, + closureType = ty }) + = ClosureInfo { closureName = nm, + closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel, + closureSMRep = BlackHoleRep, + closureSRT = NoC_SRT, + closureType = ty, + closureDescr = "" } +cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo" + +seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm, + closureType = ty }) + = ClosureInfo { closureName = nm, + closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel, + closureSMRep = BlackHoleRep, + closureSRT = NoC_SRT, + closureType = ty, + closureDescr = "" } +seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo" \end{code} %************************************************************************ @@ -999,11 +901,37 @@ The type is determined from the type information stored with the @Id@ in the closure info using @closureTypeDescr@. \begin{code} -closureTypeDescr :: ClosureInfo -> String -closureTypeDescr cl_info - = case closureLFInfo cl_info of - LFThunk ty _ _ _ _ -> getTyDescription ty - LFReEntrant ty _ _ _ -> getTyDescription ty - LFCon data_con _ -> occNameUserString (getOccName (dataConTyCon data_con)) - other -> showSDoc (ppr (closureName cl_info)) +closureValDescr, closureTypeDescr :: ClosureInfo -> String +closureValDescr (ClosureInfo {closureDescr = descr}) + = descr +closureValDescr (ConInfo {closureCon = con}) + = occNameUserString (getOccName con) + +closureTypeDescr (ClosureInfo { closureType = ty }) + = getTyDescription ty +closureTypeDescr (ConInfo { closureCon = data_con }) + = occNameUserString (getOccName (dataConTyCon data_con)) + +getTyDescription :: Type -> String +getTyDescription ty + = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) -> + case tau_ty of + TyVarTy _ -> "*" + AppTy fun _ -> getTyDescription fun + FunTy _ res -> '-' : '>' : fun_result res + NewTcApp tycon _ -> getOccString tycon + TyConApp tycon _ -> getOccString tycon + NoteTy (FTVNote _) ty -> getTyDescription ty + NoteTy (SynNote ty1) _ -> getTyDescription ty1 + PredTy sty -> getPredTyDescription sty + ForAllTy _ ty -> getTyDescription ty + } + where + fun_result (FunTy _ res) = '>' : fun_result res + fun_result other = getTyDescription other + +getPredTyDescription (ClassP cl tys) = getOccString cl +getPredTyDescription (IParam ip ty) = getOccString (ipNameName ip) \end{code} + +