X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FClosureInfo.lhs;h=d2c63b3be30a601fae3ba0511af093326ebbc924;hp=db4636866d9c7b8b547d259da6cae0a22ed72362;hb=HEAD;hpb=d31dfb32ea936c22628b508c28a36c12e631430a diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index db46368..d2c63b3 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -23,18 +23,19 @@ module ClosureInfo ( mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, - mkClosureInfo, mkConInfo, + mkClosureInfo, mkConInfo, maybeIsLFCon, closureSize, closureNonHdrSize, closureGoodStuffSize, closurePtrsSize, slopSize, - closureName, infoTableLabelFromCI, - closureLabelFromCI, closureSRT, - closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, + infoTableLabelFromCI, + closureLabelFromCI, + isLFThunk, closureUpdReqd, closureNeedsUpdSpace, closureIsThunk, closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun, + funTag, funTagLFInfo, tagForArity, enterIdLabel, enterLocalIdLabel, enterReturnPtLabel, @@ -50,7 +51,7 @@ module ClosureInfo ( closureValDescr, closureTypeDescr, -- profiling isStaticClosure, - cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo, + cafBlackHoleClosureInfo, staticClosureNeedsLink, ) where @@ -58,18 +59,19 @@ module ClosureInfo ( #include "../includes/MachDeps.h" #include "HsVersions.h" +--import CgUtils import StgSyn import SMRep import CLabel -import Packages -import PackageConfig +import Unique import StaticFlags +import Var import Id +import IdInfo import DataCon import Name -import OccName import Type import TypeRep import TcType @@ -78,6 +80,7 @@ import BasicTypes import FastString import Outputable import Constants +import DynFlags \end{code} @@ -115,8 +118,7 @@ data ClosureInfo -- the constructor's info table), and they don't have an SRT. | ConInfo { closureCon :: !DataCon, - closureSMRep :: !SMRep, - closureDllCon :: !Bool -- is in a separate DLL + closureSMRep :: !SMRep } -- C_SRT is what StgSyn.SRT gets translated to... @@ -124,13 +126,14 @@ data ClosureInfo data C_SRT = NoC_SRT | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-} + deriving (Eq) needsSRT :: C_SRT -> Bool needsSRT NoC_SRT = False needsSRT (C_SRT _ _ _) = True instance Outputable C_SRT where - ppr (NoC_SRT) = ptext SLIT("_no_srt_") + ppr (NoC_SRT) = ptext (sLit "_no_srt_") ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap)) \end{code} @@ -254,8 +257,9 @@ mkLFReEntrant :: TopLevelFlag -- True of top level mkLFReEntrant top fvs args arg_descr = LFReEntrant top (length args) (null fvs) 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 @@ -276,10 +280,16 @@ might_be_a_function ty mkConLFInfo :: DataCon -> LambdaFormInfo mkConLFInfo con = LFCon con +maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon +maybeIsLFCon (LFCon con) = Just con +maybeIsLFCon _ = Nothing + +mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) (might_be_a_function (idType id)) +mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) (might_be_a_function (idType id)) @@ -288,15 +298,17 @@ mkApLFInfo id upd_flag arity Miscellaneous LF-infos. \begin{code} +mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id = LFUnknown (might_be_a_function (idType id)) +mkLFLetNoEscape :: Int -> LambdaFormInfo mkLFLetNoEscape = LFLetNoEscape mkLFImported :: Id -> LambdaFormInfo mkLFImported id = case idArity id of n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0 - other -> mkLFArgument id -- Not sure of exact arity + _ -> mkLFArgument id -- Not sure of exact arity \end{code} \begin{code} @@ -334,15 +346,13 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr name = idName id sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds -mkConInfo :: PackageId - -> Bool -- Is static +mkConInfo :: Bool -- Is static -> DataCon -> Int -> Int -- Total and pointer words -> ClosureInfo -mkConInfo this_pkg is_static data_con tot_wds ptr_wds +mkConInfo is_static data_con tot_wds ptr_wds = ConInfo { closureSMRep = sm_rep, - closureCon = data_con, - closureDllCon = isDllName this_pkg (dataConName data_con) } + closureCon = data_con } where sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds \end{code} @@ -394,6 +404,7 @@ Slop Requirements: every thunk gets an extra padding word in the header, which takes the the updated value. \begin{code} +slopSize :: ClosureInfo -> WordOff slopSize cl_info = computeSlopSize payload_size cl_info where payload_size = closureGoodStuffSize cl_info @@ -408,6 +419,7 @@ computeSlopSize payload_size cl_info -- 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 -> Bool closureNeedsUpdSpace (ClosureInfo { closureLFInfo = LFThunk TopLevel _ _ _ _ }) = True closureNeedsUpdSpace cl_info = closureUpdReqd cl_info @@ -456,7 +468,7 @@ chooseSMRep is_static lf_info tot_wds ptr_wds getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType getClosureType is_static ptr_wds lf_info = case lf_info of - LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf + LFCon _ | is_static && ptr_wds == 0 -> ConstrNoCaf | otherwise -> Constr LFReEntrant _ _ _ _ -> Fun LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector @@ -508,7 +520,7 @@ nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _) -- or profiling (in which case we need to recover the cost centre -- from inside it) -nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _) +nodeMustPointToIt (LFThunk _ _ _ _ _) = True -- Node must point to any standard-form thunk nodeMustPointToIt (LFUnknown _) = True @@ -564,41 +576,42 @@ data CallMethod CLabel -- The code label Int -- Its arity -getCallMethod :: PackageId - -> Name -- Function being applied +getCallMethod :: DynFlags + -> Name -- Function being applied + -> CafInfo -- Can it refer to CAF's? -> LambdaFormInfo -- Its info -> Int -- Number of available arguments -> CallMethod -getCallMethod this_pkg name lf_info n_args +getCallMethod _ _ _ lf_info _ | 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 this_pkg name (LFReEntrant _ arity _ _) n_args +getCallMethod _ name caf (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 this_pkg name) arity + | otherwise = DirectEntry (enterIdLabel name caf) arity -getCallMethod this_pkg name (LFCon con) n_args +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 -getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args - | is_fun -- *Might* be a function, so we must "call" it (which is always safe) +getCallMethod _dflags _name _caf (LFThunk _ _ _updatable _std_form_info is_fun) _n_args + | is_fun -- it *might* be a function, so we must "call" it (which is + -- always safe) = SlowCall -- We cannot just enter it [in eval/apply, the entry code -- is the fast-entry code] -- Since is_fun is False, we are *definitely* looking at a data value - | updatable || opt_DoTickyProfiling -- to catch double entry - {- OLD: || opt_SMP - I decided to remove this, because in SMP mode it doesn't matter - if we enter the same thunk multiple times, so the optimisation - of jumping directly to the entry code is still valid. --SDM - -} + | otherwise = EnterIt -- We used to have ASSERT( n_args == 0 ), but actually it is -- possible for the optimiser to generate @@ -607,38 +620,49 @@ getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args -- This happens as a result of the case-of-error transformation -- So the right thing to do is just to enter the thing - | otherwise -- Jump direct to code for single-entry thunks - = ASSERT( n_args == 0 ) - JumpToIt (thunkEntryLabel this_pkg name std_form_info updatable) +-- Old version: +-- | updatable || doingTickyProfiling dflags -- to catch double entry +-- = EnterIt +-- | otherwise -- Jump direct to code for single-entry thunks +-- = JumpToIt (thunkEntryLabel name caf std_form_info updatable) +-- +-- Now we never use JumpToIt, even if the thunk is single-entry, since +-- the thunk may have already been entered and blackholed by another +-- processor. -getCallMethod this_pkg name (LFUnknown True) n_args - = SlowCall -- might be a function -getCallMethod this_pkg name (LFUnknown False) n_args - = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) - EnterIt -- Not a function +getCallMethod _ _ _ (LFUnknown True) _ + = SlowCall -- Might be a function + +getCallMethod _ name _ (LFUnknown False) n_args + | n_args > 0 + = WARN( True, ppr name <+> ppr n_args ) + SlowCall -- Note [Unsafe coerce complications] + + | otherwise + = EnterIt -- Not a function -getCallMethod this_pkg name (LFBlackHole _) n_args +getCallMethod _ _ _ (LFBlackHole _) _ = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it -getCallMethod this_pkg name (LFLetNoEscape 0) n_args +getCallMethod _ name _ (LFLetNoEscape 0) _ = JumpToIt (enterReturnPtLabel (nameUnique name)) -getCallMethod this_pkg name (LFLetNoEscape arity) n_args +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 +blackHoleOnEntry :: DynFlags -> 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 ConInfo{} = False -blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) +blackHoleOnEntry _ ConInfo{} = False +blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) | isStaticRep rep = False -- Never black-hole a static closure @@ -649,16 +673,16 @@ blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) LFThunk _ no_fvs updatable _ _ -> if updatable then not opt_OmitBlackHoling - else opt_DoTickyProfiling || not no_fvs + else doingTickyProfiling dflags || not no_fvs -- the former to catch double entry, -- and the latter to plug space-leaks. KSW/SDM 1999-04. - other -> panic "blackHoleOnEntry" -- Should never happen + _ -> panic "blackHoleOnEntry" -- Should never happen isStandardFormThunk :: LambdaFormInfo -> Bool isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True -isStandardFormThunk other_lf_info = False +isStandardFormThunk _ = False isKnownFun :: LambdaFormInfo -> Bool isKnownFun (LFReEntrant _ _ _ _) = True @@ -666,6 +690,29 @@ isKnownFun (LFLetNoEscape _) = True isKnownFun _ = False \end{code} +Note [Unsafe coerce complications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some (badly-optimised) DPH code we see this + Module X: rr :: Int = error Int "Urk" + Module Y: ...((X.rr |> g) True) ... + where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say + +It's badly optimised, because knowing that 'X.rr' is bottom, we should +have dumped the application to True. But it should still work. These +strange unsafe coercions arise from the case-of-error transformation: + (case (error Int "foo") of { ... }) True +---> (error Int "foo" |> g) True + +Anyway, the net effect is that in STG-land, when casts are discarded, +we *can* see a value of type Int applied to an argument. This only happens +if (a) the programmer made a mistake, or (b) the value of type Int is +actually bottom. + +So it's wrong to trigger an ASSERT failure in this circumstance. Instead +we now emit a WARN -- mainly to draw attention to a probably-badly-optimised +program fragment -- and do the conservative thing which is SlowCall. + + ----------------------------------------------------------------------------- SRT-related stuff @@ -688,6 +735,30 @@ staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con }) _other -> True \end{code} +Note [Entering error thunks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this + + fail :: Int + fail = error Int "Urk" + + foo :: Bool -> Bool + foo True y = (fail `cast` Bool -> Bool) y + foo False y = False + +This looks silly, but it can arise from case-of-error. Even if it +does, we'd usually see that 'fail' is a bottoming function and would +discard the extra argument 'y'. But even if that does not occur, +this program is still OK. We will enter 'fail', which never returns. + +The WARN is just to alert me to the fact that we aren't spotting that +'fail' is bottoming. + +(We are careful never to make a funtion value look like a data type, +because we can't enter a function closure -- but that is not the +problem here.) + + Avoiding generating entries and info tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At present, for every function we generate all of the following, @@ -755,13 +826,13 @@ staticClosureRequired -> StgBinderInfo -> LambdaFormInfo -> Bool -staticClosureRequired binder bndr_info +staticClosureRequired _ bndr_info (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 +staticClosureRequired _ _ _ = True \end{code} %************************************************************************ @@ -792,21 +863,43 @@ closureIsThunk ConInfo{} = False closureSingleEntry :: ClosureInfo -> Bool closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd -closureSingleEntry other_closure = False +closureSingleEntry _ = False closureReEntrant :: ClosureInfo -> Bool closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True -closureReEntrant other_closure = False +closureReEntrant _ = False 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 +closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info +closureFunInfo _ = Nothing + +lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr) +lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc) +lfFunInfo _ = Nothing + +funTag :: ClosureInfo -> Int +funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info +funTag _ = 0 + +-- maybe this should do constructor tags too? +funTagLFInfo :: LambdaFormInfo -> Int +funTagLFInfo lf + -- A function is tagged with its arity + | Just (arity,_) <- lfFunInfo lf, + Just tag <- tagForArity arity + = tag + + -- other closures (and unknown ones) are not tagged + | otherwise + = 0 + +tagForArity :: Int -> Maybe Int +tagForArity i | i <= mAX_PTR_TAG = Just i + | otherwise = Nothing \end{code} \begin{code} @@ -815,17 +908,16 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) = case lf_info of LFReEntrant TopLevel _ _ _ -> True LFThunk TopLevel _ _ _ _ -> True - other -> False + _ -> False isToplevClosure _ = False \end{code} Label generation. \begin{code} -infoTableLabelFromCI :: ClosureInfo -> CLabel +infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel infoTableLabelFromCI (ClosureInfo { closureName = name, - closureLFInfo = lf_info, - closureSMRep = rep }) + closureLFInfo = lf_info }) caf = case lf_info of LFBlackHole info -> info @@ -835,50 +927,62 @@ infoTableLabelFromCI (ClosureInfo { closureName = name, LFThunk _ _ upd_flag (ApThunk arity) _ -> mkApInfoTableLabel upd_flag arity - LFThunk{} -> mkLocalInfoTableLabel name + LFThunk{} -> mkLocalInfoTableLabel name caf - LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name + LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf - other -> panic "infoTableLabelFromCI" + _ -> panic "infoTableLabelFromCI" infoTableLabelFromCI (ConInfo { closureCon = con, - closureSMRep = rep, - closureDllCon = dll }) - | isStaticRep rep = mkStaticInfoTableLabel name dll - | otherwise = mkConInfoTableLabel name dll + closureSMRep = rep }) caf + | isStaticRep rep = mkStaticInfoTableLabel name caf + | otherwise = mkConInfoTableLabel name caf where name = dataConName con -- ClosureInfo for a closure (as opposed to a constructor) is always local -closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm -closureLabelFromCI _ = panic "closureLabelFromCI" +closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel +closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf +closureLabelFromCI _ _ = panic "closureLabelFromCI" -- thunkEntryLabel is a local help function, not exported. It's used from both -- entryLabelFromCI and getCallMethod. -thunkEntryLabel this_pkg thunk_id (ApThunk arity) is_updatable +{- UNUSED: +thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel +thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable = enterApLabel is_updatable arity -thunkEntryLabel this_pkg thunk_id (SelectorThunk offset) upd_flag +thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag = enterSelectorLabel upd_flag offset -thunkEntryLabel this_pkg thunk_id _ is_updatable - = enterIdLabel this_pkg thunk_id +thunkEntryLabel thunk_id caf _ _is_updatable + = enterIdLabel thunk_id caf +-} +{- UNUSED: +enterApLabel :: Bool -> Int -> CLabel enterApLabel is_updatable arity | tablesNextToCode = mkApInfoTableLabel is_updatable arity | otherwise = mkApEntryLabel is_updatable arity +-} +{- UNUSED: +enterSelectorLabel :: Bool -> Int -> CLabel enterSelectorLabel upd_flag offset | tablesNextToCode = mkSelectorInfoLabel upd_flag offset | otherwise = mkSelectorEntryLabel upd_flag offset +-} -enterIdLabel this_pkg id - | tablesNextToCode = mkInfoTableLabel this_pkg id - | otherwise = mkEntryLabel this_pkg id +enterIdLabel :: Name -> CafInfo -> CLabel +enterIdLabel id + | tablesNextToCode = mkInfoTableLabel id + | otherwise = mkEntryLabel id +enterLocalIdLabel :: Name -> CafInfo -> CLabel enterLocalIdLabel id | tablesNextToCode = mkLocalInfoTableLabel id | otherwise = mkLocalEntryLabel id +enterReturnPtLabel :: Unique -> CLabel enterReturnPtLabel name | tablesNextToCode = mkReturnInfoLabel name | otherwise = mkReturnPtLabel name @@ -891,6 +995,7 @@ ways to build an LFBlackHole, maintaining the invariant that it really is a black hole and not something else. \begin{code} +cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo cafBlackHoleClosureInfo (ClosureInfo { closureName = nm, closureType = ty }) = ClosureInfo { closureName = nm, @@ -900,16 +1005,6 @@ cafBlackHoleClosureInfo (ClosureInfo { closureName = nm, 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} %************************************************************************ @@ -947,7 +1042,6 @@ getTyDescription ty AppTy fun _ -> getTyDescription fun FunTy _ res -> '-' : '>' : fun_result res TyConApp tycon _ -> getOccString tycon - NoteTy (FTVNote _) ty -> getTyDescription ty PredTy sty -> getPredTyDescription sty ForAllTy _ ty -> getTyDescription ty } @@ -955,6 +1049,8 @@ getTyDescription ty 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) +getPredTyDescription :: PredType -> String +getPredTyDescription (ClassP cl _) = getOccString cl +getPredTyDescription (IParam ip _) = getOccString (ipNameName ip) +getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred" \end{code}