ClosureInfo.lhs 31.3 KB
 simonm committed Dec 02, 1998 1 %  Simon Marlow committed Oct 11, 2006 2 % (c) The University of Glasgow 2006  simonmar committed Aug 13, 2004 3 % (c) The Univserity of Glasgow 1992-2004  simonm committed Dec 02, 1998 4 %  simonmar committed Aug 13, 2004 5 6 7 8 9  Data structures which describe closures, and operations over those data structures Nothing monadic in here  partain committed Jan 08, 1996 10 11 12 13 14 15 16  Much of the rationale for these things is in the details'' part of the STG paper. \begin{code} module ClosureInfo ( ClosureInfo, LambdaFormInfo, SMRep, -- all abstract  simonmar committed Aug 13, 2004 17  StandardFormInfo,  partain committed Jan 08, 1996 18   simonmar committed Aug 13, 2004 19 20  ArgDescr(..), Liveness(..), C_SRT(..), needsSRT,  partain committed Jan 08, 1996 21   simonmar committed Aug 13, 2004 22  mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,  simonm committed Dec 02, 1998 23  mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,  partain committed Jan 08, 1996 24   simonmar committed Aug 13, 2004 25 26  mkClosureInfo, mkConInfo,  simonm committed Dec 02, 1998 27  closureSize, closureNonHdrSize,  partain committed Mar 19, 1996 28  closureGoodStuffSize, closurePtrsSize,  simonmar committed Aug 13, 2004 29  slopSize,  partain committed Jan 08, 1996 30   simonmar committed Aug 13, 2004 31 32  closureName, infoTableLabelFromCI, closureLabelFromCI, closureSRT,  simonmar committed Apr 21, 2005 33 34  closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, closureNeedsUpdSpace, closureIsThunk,  simonmar committed Aug 13, 2004 35 36  closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun,  partain committed Jan 08, 1996 37   simonmar committed Nov 26, 2004 38  enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,  simonmar committed Aug 13, 2004 39 40 41  nodeMustPointToIt, CallMethod(..), getCallMethod,  sof committed Aug 02, 1997 42   sof committed May 19, 1997 43  blackHoleOnEntry,  partain committed Jan 08, 1996 44   partain committed Mar 19, 1996 45  staticClosureRequired,  simonmar committed Aug 13, 2004 46  getClosureType,  partain committed Jan 08, 1996 47   partain committed Jun 26, 1996 48  isToplevClosure,  simonmar committed Aug 13, 2004 49  closureValDescr, closureTypeDescr, -- profiling  partain committed Jan 08, 1996 50   simonm committed Dec 02, 1998 51  isStaticClosure,  keithw committed May 11, 1999 52  cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,  simonm committed Mar 11, 1999 53 54  staticClosureNeedsLink,  partain committed Jan 08, 1996 55 56  ) where  simonmar committed Dec 11, 2002 57 #include "../includes/MachDeps.h"  simonm committed Jan 08, 1998 58 #include "HsVersions.h"  partain committed Apr 05, 1996 59   partain committed Jan 08, 1996 60 import StgSyn  Simon Marlow committed Oct 11, 2006 61 import SMRep  partain committed Jan 08, 1996 62   simonmar committed Dec 11, 2002 63 import CLabel  simonmar committed Aug 13, 2004 64   Simon Marlow committed Oct 11, 2006 65 66 67 68 69 70 71 72 73 74 75 76 import Packages import PackageConfig import StaticFlags import Id import DataCon import Name import OccName import Type import TypeRep import TcType import TyCon import BasicTypes  simonmar committed Apr 29, 2002 77 import FastString  simonm committed Jan 08, 1998 78 import Outputable  simonmar committed Dec 11, 2002 79 import Constants  partain committed Jan 08, 1996 80 81 \end{code}  simonmar committed Aug 13, 2004 82   partain committed Jan 08, 1996 83 84 85 86 87 88 %************************************************************************ %* * \subsection[ClosureInfo-datatypes]{Data types for closure information} %* * %************************************************************************  simonmar committed Dec 11, 2002 89 90 91 92 93 94 95 96 97 98 99 100 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)  simonpj committed Sep 26, 2001 101 102 103  \begin{code} data ClosureInfo  simonmar committed Dec 11, 2002 104 105 106 107 108 109 110 111 112  = 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) }  simonmar committed Aug 13, 2004 113  -- Constructor closures don't have a unique info table label (they use  simonmar committed Dec 11, 2002 114 115 116  -- the constructor's info table), and they don't have an SRT. | ConInfo { closureCon :: !DataCon,  simonmar committed Nov 26, 2004 117 118  closureSMRep :: !SMRep, closureDllCon :: !Bool -- is in a separate DLL  simonpj committed Sep 26, 2001 119  }  simonmar committed Aug 13, 2004 120 121 122 123 124 125 126 127 128 129  -- 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  simonpj committed Sep 26, 2001 130 131 \end{code}  partain committed Jan 08, 1996 132 133 134 135 136 137 %************************************************************************ %* * \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info} %* * %************************************************************************  simonmar committed Dec 11, 2002 138 139 140 141 142 143 144 145 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.  partain committed Jan 08, 1996 146 147 \begin{code} data LambdaFormInfo  simonmar committed Dec 11, 2002 148  = LFReEntrant -- Reentrant closure (a function)  simonm committed Dec 02, 1998 149  TopLevelFlag -- True if top level  simonmar committed Aug 13, 2004 150  !Int -- Arity. Invariant: always > 0  simonm committed Dec 02, 1998 151  !Bool -- True <=> no fvs  simonmar committed Dec 11, 2002 152  ArgDescr -- Argument descriptor (should reall be in ClosureInfo)  partain committed Jan 08, 1996 153   simonmar committed Aug 13, 2004 154  | LFCon -- A saturated constructor application  simonm committed Dec 02, 1998 155  DataCon -- The constructor  partain committed Mar 19, 1996 156   partain committed Jan 08, 1996 157  | LFThunk -- Thunk (zero arity)  simonm committed Dec 02, 1998 158 159  TopLevelFlag !Bool -- True <=> no free vars  simonmar committed Dec 11, 2002 160  !Bool -- True <=> updatable (i.e., *not* single-entry)  partain committed Jan 08, 1996 161  StandardFormInfo  simonmar committed Dec 11, 2002 162  !Bool -- True <=> *might* be a function type  partain committed Jan 08, 1996 163   simonmar committed Dec 11, 2002 164 165 166  | LFUnknown -- Used for function arguments and imported things. -- We know nothing about this closure. Treat like -- updatable "LFThunk"...  partain committed Jan 08, 1996 167 168 169  -- Imported things which we do know something about use -- one of the other LF constructors (eg LFReEntrant for -- known functions)  simonmar committed Dec 11, 2002 170  !Bool -- True <=> *might* be a function type  partain committed Jan 08, 1996 171 172 173  | LFLetNoEscape -- See LetNoEscape module for precise description of -- these "lets".  simonmar committed Dec 11, 2002 174  !Int -- arity;  partain committed Jan 08, 1996 175 176 177 178  | LFBlackHole -- Used for the closures allocated to hold the result -- of a CAF. We want the target of the update frame to -- be in the heap, so we make a black hole to hold it.  keithw committed May 11, 1999 179  CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).  partain committed Jan 08, 1996 180 181   simonmar committed Aug 13, 2004 182 183 ------------------------- -- An ArgDsecr describes the argument pattern of a function  partain committed Jan 08, 1996 184   simonmar committed Aug 13, 2004 185 186 187 data ArgDescr = ArgSpec -- Fits one of the standard patterns !Int -- RTS type identifier ARG_P, ARG_N, ...  partain committed Jan 08, 1996 188   simonmar committed Aug 13, 2004 189 190  | ArgGen -- General case Liveness -- Details about the arguments  partain committed Mar 19, 1996 191   partain committed Jan 08, 1996 192   simonmar committed Aug 13, 2004 193 194 195 196 197 198 199 200 ------------------------- -- 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.  partain committed Mar 19, 1996 201   simonmar committed Aug 13, 2004 202 203 204 205 206 207 data Liveness = SmallLiveness -- Liveness info that fits in one word StgWord -- Here's the bitmap | BigLiveness -- Liveness info witha a multi-word bitmap CLabel -- Label for the bitmap  partain committed Mar 19, 1996 208 209   simonmar committed Aug 13, 2004 210 211 212 ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms  partain committed Jan 08, 1996 213   simonmar committed Aug 13, 2004 214 215 216 data StandardFormInfo = NonStandardThunk -- Not of of the standard forms  partain committed Jan 08, 1996 217   simonmar committed Aug 13, 2004 218 219 220 221 222 223 224 225  | 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.)  partain committed Jan 08, 1996 226   simonmar committed Aug 13, 2004 227 228 229 230 231 232 233  | 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  partain committed Jan 08, 1996 234 235 236 237 238 239 240 241 242 \end{code} %************************************************************************ %* * \subsection[ClosureInfo-construction]{Functions which build LFInfos} %* * %************************************************************************ \begin{code}  simonmar committed Aug 13, 2004 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 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)  simonmar committed Dec 11, 2002 258 259 260 261  might_be_a_function :: Type -> Bool might_be_a_function ty | Just (tc,_) <- splitTyConApp_maybe (repType ty),  simonmar committed Aug 13, 2004 262  not (isFunTyCon tc) && not (isAbstractTyCon tc) = False  simonmar committed Mar 31, 2004 263 264  -- don't forget to check for abstract types, which might -- be functions too.  simonmar committed Dec 11, 2002 265  | otherwise = True  partain committed Jan 08, 1996 266 267 268 269 270 271 \end{code} @mkConLFInfo@ is similar, for constructors. \begin{code} mkConLFInfo :: DataCon -> LambdaFormInfo  simonmar committed Dec 11, 2002 272 mkConLFInfo con = LFCon con  partain committed Jan 08, 1996 273   simonmar committed Dec 11, 2002 274 275 276 mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) (might_be_a_function (idType id))  simonpj committed Dec 19, 1996 277   simonmar committed Dec 11, 2002 278 279 280 mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) (might_be_a_function (idType id))  partain committed Jan 08, 1996 281 282 \end{code}  simonm committed Dec 02, 1998 283 284 285 Miscellaneous LF-infos. \begin{code}  simonmar committed Dec 11, 2002 286 287 mkLFArgument id = LFUnknown (might_be_a_function (idType id))  simonm committed Dec 02, 1998 288 289 290 291 mkLFLetNoEscape = LFLetNoEscape mkLFImported :: Id -> LambdaFormInfo mkLFImported id  simonpj committed Oct 18, 2001 292  = case idArity id of  simonmar committed Dec 11, 2002 293 294  n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0 other -> mkLFArgument id -- Not sure of exact arity  simonm committed Dec 02, 1998 295 \end{code}  partain committed Jan 08, 1996 296   simonmar committed Apr 21, 2005 297 298 299 300 301 302 303 304 305 306 \begin{code} isLFThunk :: LambdaFormInfo -> Bool isLFThunk (LFThunk _ _ _ _ _) = True isLFThunk (LFBlackHole _) = True -- return True for a blackhole: this function is used to determine -- whether to use the thunk header in SMP mode, and a blackhole -- must have one. isLFThunk _ = False \end{code}  simonmar committed Aug 13, 2004 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 %************************************************************************ %* * 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  Simon Marlow committed Jul 25, 2006 332 mkConInfo :: PackageId  simonmar committed Nov 26, 2004 333  -> Bool -- Is static  simonmar committed Aug 13, 2004 334 335 336  -> DataCon -> Int -> Int -- Total and pointer words -> ClosureInfo  Simon Marlow committed Jul 25, 2006 337 mkConInfo this_pkg is_static data_con tot_wds ptr_wds  simonmar committed Aug 13, 2004 338  = ConInfo { closureSMRep = sm_rep,  simonmar committed Nov 26, 2004 339  closureCon = data_con,  Simon Marlow committed Jul 25, 2006 340  closureDllCon = isDllName this_pkg (dataConName data_con) }  simonmar committed Aug 13, 2004 341 342 343 344  where sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds \end{code}  partain committed Jan 08, 1996 345 346 347 348 349 350 351 %************************************************************************ %* * \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}} %* * %************************************************************************ \begin{code}  simonmar committed Aug 13, 2004 352 closureSize :: ClosureInfo -> WordOff  simonmar committed Apr 21, 2005 353 354 355 356 357 358 359 360 closureSize cl_info = hdr_size + closureNonHdrSize cl_info where hdr_size | closureIsThunk cl_info = thunkHdrSize | otherwise = fixedHdrSize -- All thunks use thunkHdrSize, even if they are non-updatable. -- this is because we don't have separate closure types for -- updatable vs. non-updatable thunks, so the GC can't tell the -- difference. If we ever have significant numbers of non- -- updatable thunks, it might be worth fixing this.  partain committed Jan 08, 1996 361   simonmar committed Aug 13, 2004 362 closureNonHdrSize :: ClosureInfo -> WordOff  simonpj committed Sep 26, 2001 363 closureNonHdrSize cl_info  simonmar committed Apr 21, 2005 364  = tot_wds + computeSlopSize tot_wds cl_info  partain committed Jan 08, 1996 365 366 367  where tot_wds = closureGoodStuffSize cl_info  simonmar committed Aug 13, 2004 368 closureGoodStuffSize :: ClosureInfo -> WordOff  simonpj committed Sep 26, 2001 369 370 closureGoodStuffSize cl_info = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)  partain committed Jan 08, 1996 371 372  in ptrs + nonptrs  simonmar committed Aug 13, 2004 373 closurePtrsSize :: ClosureInfo -> WordOff  simonpj committed Sep 26, 2001 374 375 closurePtrsSize cl_info = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)  partain committed Jan 08, 1996 376 377 378  in ptrs -- not exported:  simonmar committed Aug 13, 2004 379 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)  simonpj committed Mar 23, 2000 380 381 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs) sizes_from_SMRep BlackHoleRep = (0, 0)  partain committed Jan 08, 1996 382 383 384 385 386 387 \end{code} Computing slop size. WARNING: this looks dodgy --- it has deep knowledge of what the storage manager does with the various representations...  Simon Marlow committed Feb 08, 2006 388 389 Slop Requirements: every thunk gets an extra padding word in the header, which takes the the updated value.  simonm committed Dec 02, 1998 390   partain committed Jan 08, 1996 391 \begin{code}  simonmar committed Apr 21, 2005 392 393 slopSize cl_info = computeSlopSize payload_size cl_info where payload_size = closureGoodStuffSize cl_info  partain committed Jan 08, 1996 394   simonmar committed Apr 21, 2005 395 396 397 398 399 400 computeSlopSize :: WordOff -> ClosureInfo -> WordOff computeSlopSize payload_size cl_info = max 0 (minPayloadSize smrep updatable - payload_size) where smrep = closureSMRep cl_info updatable = closureNeedsUpdSpace cl_info  simonpj committed Mar 23, 2000 401   simonmar committed Apr 21, 2005 402 403 404 405 406 407 408 -- 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  simonpj committed Mar 23, 2000 409   simonmar committed Apr 21, 2005 410 411 412 413 414 415 minPayloadSize :: SMRep -> Bool -> WordOff minPayloadSize smrep updatable = case smrep of BlackHoleRep -> min_upd_size GenericRep _ _ _ _ | updatable -> min_upd_size GenericRep True _ _ _ -> 0 -- static  Simon Marlow committed Feb 08, 2006 416  GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE  simonmar committed Apr 21, 2005 417 418  -- ^^^^^___ dynamic where  Simon Marlow committed Feb 08, 2006 419 420 421 422 423  min_upd_size = ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader) 0 -- check that we already have enough -- room for mIN_SIZE_NonUpdHeapObject, -- due to the extra header word in SMP  partain committed Jan 08, 1996 424 425 426 427 428 429 430 431 432 \end{code} %************************************************************************ %* * \subsection[SMreps]{Choosing SM reps} %* * %************************************************************************ \begin{code}  simonmar committed Dec 11, 2002 433 434 435 chooseSMRep :: Bool -- True <=> static closure -> LambdaFormInfo  simonmar committed Aug 13, 2004 436  -> WordOff -> WordOff -- Tot wds, ptr wds  partain committed Jan 08, 1996 437 438  -> SMRep  simonmar committed Dec 11, 2002 439 chooseSMRep is_static lf_info tot_wds ptr_wds  partain committed Jan 08, 1996 440  = let  simonpj committed Mar 23, 2000 441  nonptr_wds = tot_wds - ptr_wds  simonmar committed Aug 13, 2004 442  closure_type = getClosureType is_static ptr_wds lf_info  partain committed Jan 08, 1996 443  in  simonpj committed Mar 23, 2000 444  GenericRep is_static ptr_wds nonptr_wds closure_type  simonm committed Mar 04, 1999 445   simonmar committed Aug 13, 2004 446 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g  simonm committed Mar 04, 1999 447 448 449 -- 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.  simonm committed Jan 26, 1999 450   simonmar committed Aug 13, 2004 451 452 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType getClosureType is_static ptr_wds lf_info  simonpj committed Mar 23, 2000 453  = case lf_info of  simonpj committed Dec 11, 2002 454 455 456 457 458  LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf | otherwise -> Constr LFReEntrant _ _ _ _ -> Fun LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector LFThunk _ _ _ _ _ -> Thunk  simonpj committed Mar 23, 2000 459  _ -> panic "getClosureType"  partain committed Jan 08, 1996 460 461 462 463 464 465 466 467 468 469 470 \end{code} %************************************************************************ %* * \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@} %* * %************************************************************************ Be sure to see the stg-details notes about these... \begin{code}  simonmar committed Aug 13, 2004 471 472 473 474 nodeMustPointToIt :: LambdaFormInfo -> Bool nodeMustPointToIt (LFReEntrant top _ no_fvs _) = not no_fvs || -- Certainly if it has fvs we need to point to it isNotTopLevel top  simonm committed Dec 02, 1998 475  -- If it is not top level we will point to it  partain committed Jan 08, 1996 476 477 478 479 480 481 482 483  -- We can have a \r closure with no_fvs which -- is not top level as special case cgRhsClosure -- has been dissabled in favour of let floating -- 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.  simonmar committed Aug 13, 2004 484 nodeMustPointToIt (LFCon _) = True  partain committed Jan 08, 1996 485 486 487 488 489 490 491 492 493 494 495 496  -- Strictly speaking, the above two don't need Node to point -- to it if the arity = 0. But this is a *really* unlikely -- situation. If we know it's nil (say) and we are entering -- it. Eg: let x = [] in x then we will certainly have inlined -- x, since nil is a simple atom. So we gain little by not -- having Node point to known zero-arity things. On the other -- hand, we do lose something; Patrick's code for figuring out -- when something has been updated but not entered relies on -- having Node point to the result of an update. SLPJ -- 27/11/92.  simonmar committed Aug 13, 2004 497 498 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _) = updatable || not no_fvs || opt_SccProfilingOn  partain committed Jan 08, 1996 499 500 501 502 503 504 505  -- For the non-updatable (single-entry case): -- -- True if has fvs (in which case we need access to them, and we -- should black-hole it) -- or profiling (in which case we need to recover the cost centre -- from inside it)  simonmar committed Aug 13, 2004 506 507 nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _) = True -- Node must point to any standard-form thunk  sof committed Jul 05, 1997 508   simonmar committed Aug 13, 2004 509 510 511 nodeMustPointToIt (LFUnknown _) = True nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point nodeMustPointToIt (LFLetNoEscape _) = False  partain committed Jan 08, 1996 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 \end{code} The entry conventions depend on the type of closure being entered, whether or not it has free variables, and whether we're running sequentially or in parallel. \begin{tabular}{lllll} Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\ Unknown & no & yes & stack & node \\ Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\ \ & \ & \ & \ & slow entry (otherwise) \\ Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\ 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\ 0 arg, no fvs @\u@ & no & yes & n/a & node \\ 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\ 0 arg, fvs @\u@ & no & yes & n/a & node \\ Unknown & yes & yes & stack & node \\ Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\ \ & \ & \ & \ & slow entry (otherwise) \\ Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\ 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\ 0 arg, no fvs @\u@ & yes & yes & n/a & node \\ 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\ 0 arg, fvs @\u@ & yes & yes & n/a & node\\ \end{tabular}  partain committed Mar 19, 1996 539 When black-holing, single-entry closures could also be entered via node  partain committed Jan 08, 1996 540 541 542 (rather than directly) to catch double-entry. \begin{code}  simonmar committed Aug 13, 2004 543 data CallMethod  simonmar committed Dec 11, 2002 544  = EnterIt -- no args, not a function  partain committed Jan 08, 1996 545   simonmar committed Dec 11, 2002 546 547 548 549 550 551 552  | 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.  simonmar committed Aug 13, 2004 553 554  | ReturnCon DataCon -- It's a data constructor, just return it  simonmar committed Dec 11, 2002 555 556  | SlowCall -- Unknown fun, or known fun with -- too few args.  partain committed Jan 08, 1996 557   simonm committed Dec 02, 1998 558  | DirectEntry -- Jump directly, with args in regs  partain committed Jan 08, 1996 559 560  CLabel -- The code label Int -- Its arity  simonmar committed Aug 13, 2004 561   Simon Marlow committed Jul 25, 2006 562 getCallMethod :: PackageId  simonmar committed Nov 26, 2004 563  -> Name -- Function being applied  simonmar committed Aug 13, 2004 564 565 566 567  -> LambdaFormInfo -- Its info -> Int -- Number of available arguments -> CallMethod  Simon Marlow committed Jul 25, 2006 568 getCallMethod this_pkg name lf_info n_args  simonmar committed Aug 13, 2004 569 570 571 572 573 574  | 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  Simon Marlow committed Jul 25, 2006 575 getCallMethod this_pkg name (LFReEntrant _ arity _ _) n_args  simonmar committed Aug 13, 2004 576 577 578  | n_args == 0 = ASSERT( arity /= 0 ) ReturnIt -- No args at all | n_args < arity = SlowCall -- Not enough args  Simon Marlow committed Jul 25, 2006 579  | otherwise = DirectEntry (enterIdLabel this_pkg name) arity  simonmar committed Aug 13, 2004 580   Simon Marlow committed Jul 25, 2006 581 getCallMethod this_pkg name (LFCon con) n_args  simonmar committed Aug 13, 2004 582 583 584  = ASSERT( n_args == 0 ) ReturnCon con  Simon Marlow committed Jul 25, 2006 585 getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args  simonpj@microsoft.com committed Oct 18, 2006 586 587  | is_fun -- *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  simonmar committed Aug 13, 2004 588 589  -- is the fast-entry code]  simonpj@microsoft.com committed Oct 18, 2006 590  -- Since is_fun is False, we are *definitely* looking at a data value  simonmar committed Aug 13, 2004 591  | updatable || opt_DoTickyProfiling -- to catch double entry  Simon Marlow committed Feb 08, 2006 592 593 594 595 596  {- 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 -}  simonpj@microsoft.com committed Oct 18, 2006 597  = ASSERT2( n_args == 0, ppr name ) EnterIt  partain committed Jan 08, 1996 598   simonmar committed Aug 13, 2004 599 600  | otherwise -- Jump direct to code for single-entry thunks = ASSERT( n_args == 0 )  Simon Marlow committed Jul 25, 2006 601  JumpToIt (thunkEntryLabel this_pkg name std_form_info updatable)  simonmar committed Aug 13, 2004 602   Simon Marlow committed Jul 25, 2006 603 getCallMethod this_pkg name (LFUnknown True) n_args  simonmar committed Aug 13, 2004 604 605  = SlowCall -- might be a function  Simon Marlow committed Jul 25, 2006 606 getCallMethod this_pkg name (LFUnknown False) n_args  simonmar committed Aug 13, 2004 607 608  = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function  partain committed Jan 08, 1996 609   Simon Marlow committed Jul 25, 2006 610 getCallMethod this_pkg name (LFBlackHole _) n_args  simonmar committed Aug 13, 2004 611 612 613 614  = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it  Simon Marlow committed Jul 25, 2006 615 getCallMethod this_pkg name (LFLetNoEscape 0) n_args  simonmar committed Aug 13, 2004 616 617  = JumpToIt (enterReturnPtLabel (nameUnique name))  Simon Marlow committed Jul 25, 2006 618 getCallMethod this_pkg name (LFLetNoEscape arity) n_args  simonmar committed Aug 13, 2004 619 620 621 622  | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity) blackHoleOnEntry :: ClosureInfo -> Bool  partain committed Jan 08, 1996 623 -- Static closures are never themselves black-holed.  simonm committed Dec 02, 1998 624 625 626 627 -- 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.  partain committed Jan 08, 1996 628   simonmar committed Dec 11, 2002 629 630 631 blackHoleOnEntry ConInfo{} = False blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) | isStaticRep rep  simonpj committed Sep 26, 2001 632  = False -- Never black-hole a static closure  partain committed Jan 08, 1996 633   simonpj committed Sep 26, 2001 634  | otherwise  simonmar committed Dec 11, 2002 635  = case lf_info of  simonpj committed Sep 26, 2001 636  LFReEntrant _ _ _ _ -> False  simonm committed Dec 02, 1998 637  LFLetNoEscape _ -> False  simonmar committed Dec 11, 2002 638  LFThunk _ no_fvs updatable _ _  partain committed Jan 08, 1996 639  -> if updatable  simonm committed Dec 02, 1998 640  then not opt_OmitBlackHoling  keithw committed May 11, 1999 641 642 643 644  else opt_DoTickyProfiling || not no_fvs -- the former to catch double entry, -- and the latter to plug space-leaks. KSW/SDM 1999-04.  partain committed Mar 19, 1996 645  other -> panic "blackHoleOnEntry" -- Should never happen  partain committed Jan 08, 1996 646   simonm committed Dec 02, 1998 647 isStandardFormThunk :: LambdaFormInfo -> Bool  simonmar committed Dec 11, 2002 648 649 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True  simonpj committed Sep 26, 2001 650 isStandardFormThunk other_lf_info = False  partain committed Jan 08, 1996 651   simonmar committed Aug 13, 2004 652 653 654 655 isKnownFun :: LambdaFormInfo -> Bool isKnownFun (LFReEntrant _ _ _ _) = True isKnownFun (LFLetNoEscape _) = True isKnownFun _ = False  simonm committed Mar 11, 1999 656 657 658 659 \end{code} ----------------------------------------------------------------------------- SRT-related stuff  partain committed Jan 08, 1996 660   simonm committed Mar 11, 1999 661 662 \begin{code} staticClosureNeedsLink :: ClosureInfo -> Bool  simonpj committed Sep 26, 2001 663 664 665 -- 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  simonmar committed Jan 02, 2002 666 -- b) it's a constructor with one or more pointer fields  simonpj committed Sep 26, 2001 667 668 -- In case (b), the constructor's fields themselves play the role -- of the SRT.  simonmar committed Dec 11, 2002 669 670 671 staticClosureNeedsLink (ClosureInfo { closureSRT = srt }) = needsSRT srt staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })  simonpj committed Sep 30, 2004 672  = not (isNullaryRepDataCon con) && not_nocaf_constr  simonpj committed Sep 26, 2001 673  where  simonmar committed Jan 02, 2002 674 675  not_nocaf_constr = case sm_rep of  simonpj committed Dec 11, 2002 676 677  GenericRep _ _ _ ConstrNoCaf -> False _other -> True  partain committed Jan 08, 1996 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 \end{code} Avoiding generating entries and info tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At present, for every function we generate all of the following, just in case. But they aren't always all needed, as noted below: [NB1: all of this applies only to *functions*. Thunks always have closure, info table, and entry code.] [NB2: All are needed if the function is *exported*, just to play safe.] * Fast-entry code ALWAYS NEEDED * Slow-entry code Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) we're in the parallel world and the function has free vars [Reason: in parallel world, we always enter functions with free vars via the closure.] * The function closure Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) if the function has free vars (ie not top level)  partain committed Mar 19, 1996 705  Why case (a) here? Because if the arg-satis check fails,  partain committed Jan 08, 1996 706 707 708 709  UpdatePAP stuffs a pointer to the function closure in the PAP. [Could be changed; UpdatePAP could stuff in a code ptr instead, but doesn't seem worth it.]  partain committed Mar 19, 1996 710  [NB: these conditions imply that we might need the closure  partain committed Jan 08, 1996 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725  without the slow-entry code. Here's how. f x y = let g w = ...x..y..w... in ...(g t)... Here we need a closure for g which contains x and y, but since the calls are all saturated we just jump to the fast entry point for g, with R1 pointing to the closure for g.] * Standard info table Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) the function has free vars (ie not top level)  partain committed Mar 19, 1996 726   partain committed Jan 08, 1996 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742  NB. In the sequential world, (c) is only required so that the function closure has an info table to point to, to keep the storage manager happy. If (c) alone is true we could fake up an info table by choosing one of a standard family of info tables, whose entry code just bombs out. [NB In the parallel world (c) is needed regardless because we enter functions with free vars via the closure.] If (c) is retained, then we'll sometimes generate an info table (for storage mgr purposes) without slow-entry code. Then we need to use an error label in the info table to substitute for the absent slow entry code. \begin{code} staticClosureRequired  simonm committed Dec 02, 1998 743  :: Name  partain committed Mar 19, 1996 744  -> StgBinderInfo  partain committed Jan 08, 1996 745 746  -> LambdaFormInfo -> Bool  simonpj committed Feb 20, 2001 747 staticClosureRequired binder bndr_info  simonmar committed Dec 11, 2002 748  (LFReEntrant top_level _ _ _) -- It's a function  simonpj committed May 18, 1999 749  = ASSERT( isTopLevel top_level )  simonm committed Dec 02, 1998 750  -- Assumption: it's a top-level, no-free-var binding  simonpj committed Feb 20, 2001 751  not (satCallsOnly bndr_info)  partain committed Jan 08, 1996 752 753  staticClosureRequired binder other_binder_info other_lf_info = True  simonpj committed Dec 19, 1996 754 755 \end{code}  partain committed Jan 08, 1996 756 757 758 759 760 761 762 763 764 %************************************************************************ %* * \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.} %* * %************************************************************************ \begin{code} isStaticClosure :: ClosureInfo -> Bool  simonpj committed Sep 26, 2001 765 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)  partain committed Jan 08, 1996 766 767  closureUpdReqd :: ClosureInfo -> Bool  simonmar committed Apr 21, 2005 768 769 770 771 772 773 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info closureUpdReqd ConInfo{} = False lfUpdatable :: LambdaFormInfo -> Bool lfUpdatable (LFThunk _ _ upd _ _) = upd lfUpdatable (LFBlackHole _) = True  partain committed Jan 08, 1996 774 775  -- Black-hole closures are allocated to receive the results of an -- alg case with a named default... so they need to be updated.  simonmar committed Apr 21, 2005 776 777 778 779 780 lfUpdatable _ = False closureIsThunk :: ClosureInfo -> Bool closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info closureIsThunk ConInfo{} = False  partain committed Jan 08, 1996 781 782  closureSingleEntry :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 783 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd  simonpj committed Sep 26, 2001 784 closureSingleEntry other_closure = False  simonm committed Mar 22, 1999 785 786  closureReEntrant :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 787 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True  simonm committed Mar 22, 1999 788 closureReEntrant other_closure = False  partain committed Jan 08, 1996 789   simonmar committed Aug 13, 2004 790 791 792 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con isConstrClosure_maybe _ = Nothing  simonmar committed Dec 11, 2002 793 794 795 796 797 798  closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr) closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc}) = Just (arity, arg_desc) closureFunInfo _ = Nothing  partain committed Jan 08, 1996 799 800 \end{code}  partain committed Jun 26, 1996 801 802 \begin{code} isToplevClosure :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 803 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })  partain committed Jun 26, 1996 804  = case lf_info of  simonmar committed Dec 11, 2002 805 806  LFReEntrant TopLevel _ _ _ -> True LFThunk TopLevel _ _ _ _ -> True  simonm committed Dec 02, 1998 807  other -> False  simonmar committed Dec 11, 2002 808 isToplevClosure _ = False  simonm committed Dec 02, 1998 809 810 \end{code}  partain committed Jan 08, 1996 811 812 813 Label generation. \begin{code}  simonpj committed Dec 19, 1996 814 infoTableLabelFromCI :: ClosureInfo -> CLabel  simonmar committed Dec 11, 2002 815 816 817 infoTableLabelFromCI (ClosureInfo { closureName = name, closureLFInfo = lf_info, closureSMRep = rep })  partain committed Jan 08, 1996 818  = case lf_info of  keithw committed May 11, 1999 819  LFBlackHole info -> info  partain committed Jan 08, 1996 820   simonmar committed Dec 11, 2002 821  LFThunk _ _ upd_flag (SelectorThunk offset) _ ->  simonm committed Dec 02, 1998 822  mkSelectorInfoLabel upd_flag offset  partain committed Jan 08, 1996 823   simonmar committed Dec 11, 2002 824  LFThunk _ _ upd_flag (ApThunk arity) _ ->  simonm committed Dec 02, 1998 825  mkApInfoTableLabel upd_flag arity  partain committed Jan 08, 1996 826   simonmar committed Nov 26, 2004 827  LFThunk{} -> mkLocalInfoTableLabel name  simonmar committed Dec 11, 2002 828   simonmar committed Nov 26, 2004 829  LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name  simonmar committed Dec 11, 2002 830 831 832  other -> panic "infoTableLabelFromCI"  simonmar committed Nov 26, 2004 833 834 835 836 837 infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep, closureDllCon = dll }) | isStaticRep rep = mkStaticInfoTableLabel name dll | otherwise = mkConInfoTableLabel name dll  simonm committed Dec 02, 1998 838 839  where name = dataConName con  partain committed Jan 08, 1996 840   simonmar committed Nov 26, 2004 841 842 -- ClosureInfo for a closure (as opposed to a constructor) is always local closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm  simonmar committed Dec 11, 2002 843 closureLabelFromCI _ = panic "closureLabelFromCI"  partain committed Jan 08, 1996 844 845  -- thunkEntryLabel is a local help function, not exported. It's used from both  simonmar committed Aug 13, 2004 846 -- entryLabelFromCI and getCallMethod.  partain committed Jan 08, 1996 847   Simon Marlow committed Jul 25, 2006 848 thunkEntryLabel this_pkg thunk_id (ApThunk arity) is_updatable  simonmar committed Aug 13, 2004 849  = enterApLabel is_updatable arity  Simon Marlow committed Jul 25, 2006 850 thunkEntryLabel this_pkg thunk_id (SelectorThunk offset) upd_flag  simonmar committed Aug 13, 2004 851  = enterSelectorLabel upd_flag offset  Simon Marlow committed Jul 25, 2006 852 853 thunkEntryLabel this_pkg thunk_id _ is_updatable = enterIdLabel this_pkg thunk_id  partain committed Jan 08, 1996 854   simonmar committed Aug 13, 2004 855 856 857 858 859 860 861 862 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  Simon Marlow committed Jul 25, 2006 863 864 865 enterIdLabel this_pkg id | tablesNextToCode = mkInfoTableLabel this_pkg id | otherwise = mkEntryLabel this_pkg id  simonmar committed Nov 26, 2004 866 867 868 869  enterLocalIdLabel id | tablesNextToCode = mkLocalInfoTableLabel id | otherwise = mkLocalEntryLabel id  simonmar committed Aug 13, 2004 870 871 872 873  enterReturnPtLabel name | tablesNextToCode = mkReturnInfoLabel name | otherwise = mkReturnPtLabel name  partain committed Jan 08, 1996 874 875 \end{code}  simonmar committed Aug 13, 2004 876   partain committed Apr 05, 1996 877 We need a black-hole closure info to pass to @allocDynClosure@ when we  keithw committed May 11, 1999 878 879 880 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.  partain committed Jan 08, 1996 881 882  \begin{code}  simonmar committed Dec 11, 2002 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 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"  partain committed Jan 08, 1996 902 903 904 905 906 907 908 909 \end{code} %************************************************************************ %* * \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.} %* * %************************************************************************  simonm committed Dec 02, 1998 910 911 Profiling requires two pieces of information to be determined for each closure's info table --- description and type.  partain committed Jan 08, 1996 912 913 914 915 916 917 918 919  The description is stored directly in the @CClosureInfoTable@ when the info table is built. The type is determined from the type information stored with the @Id@ in the closure info using @closureTypeDescr@. \begin{code}  simonmar committed Aug 13, 2004 920 921 922 923 closureValDescr, closureTypeDescr :: ClosureInfo -> String closureValDescr (ClosureInfo {closureDescr = descr}) = descr closureValDescr (ConInfo {closureCon = con})  simonmar committed Jan 06, 2006 924  = occNameString (getOccName con)  simonmar committed Aug 13, 2004 925   simonmar committed Dec 11, 2002 926 927 928 closureTypeDescr (ClosureInfo { closureType = ty }) = getTyDescription ty closureTypeDescr (ConInfo { closureCon = data_con })  simonmar committed Jan 06, 2006 929  = occNameString (getOccName (dataConTyCon data_con))  simonpj committed Oct 30, 2003 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948  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 TyConApp tycon _ -> getOccString tycon NoteTy (FTVNote _) ty -> getTyDescription ty 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)  simonmar committed Dec 11, 2002 949 950 951 \end{code}