2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
6 (And a pretty good illustration of quite a few things wrong with
10 #include "HsVersions.h"
17 applySubstToIdInfo, apply_to_IdInfo, -- not for general use, please
20 exactArity, atLeastArity, unknownArity,
21 arityInfo, addArityInfo, ppArityInfo,
24 noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, addDemandInfo, willBeDemanded,
26 StrictnessInfo(..), -- Non-abstract
27 Demand(..), NewOrData, -- Non-abstract
30 mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
31 strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
33 unfoldInfo, addUnfoldInfo,
35 specInfo, addSpecInfo,
37 UpdateInfo, SYN_IE(UpdateSpec),
38 mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
40 ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType),
41 mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
43 FBTypeInfo, FBType(..), FBConsum(..), FBProd(..),
44 fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType
48 IMPORT_1_3(Char(toLower))
50 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
51 IMPORT_DELOOPER(IdLoop) -- IdInfo is a dependency-loop ranch, and
52 -- we break those loops by using IdLoop and
53 -- *not* importing much of anything else,
54 -- except from the very general "utils".
56 import {-# SOURCE #-} SpecEnv
57 import {-# SOURCE #-} Id
58 import {-# SOURCE #-} CoreUnfold
59 import {-# SOURCE #-} StdIdInfo
62 import BasicTypes ( NewOrData )
63 import CmdLineOpts ( opt_OmitInterfacePragmas )
66 import Maybes ( firstJust )
67 import Outputable ( ifaceStyle, PprStyle(..), Outputable(..){-instances-} )
70 import Unique ( pprUnique )
71 import Util ( mapAccumL, panic, assertPanic, pprPanic )
73 #ifdef REALLY_HASKELL_1_3
74 ord = fromEnum :: Char -> Int
77 showTypeCategory = panic "IdInfo.showTypeCategory"
80 An @IdInfo@ gives {\em optional} information about an @Id@. If
81 present it never lies, but it may not be present, in which case there
82 is always a conservative assumption which can be made.
84 Two @Id@s may have different info even though they have the same
85 @Unique@ (and are hence the same @Id@); for example, one might lack
86 the properties attached to the other.
88 The @IdInfo@ gives information about the value, or definition, of the
89 @Id@. It does {\em not} contain information about the @Id@'s usage
90 (except for @DemandInfo@? ToDo).
95 ArityInfo -- Its arity
97 DemandInfo -- Whether or not it is definitely
100 SpecEnv -- Specialisations of this function which exist
102 StrictnessInfo -- Strictness properties
104 Unfolding -- Its unfolding; for locally-defined
105 -- things, this can *only* be NoUnfolding
107 UpdateInfo -- Which args should be updated
109 ArgUsageInfo -- how this Id uses its arguments
111 FBTypeInfo -- the Foldr/Build W/W property of this function.
115 noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding
116 NoUpdateInfo NoArgUsageInfo NoFBTypeInfo
119 Simply turgid. But BE CAREFUL: don't @apply_to_Id@ if that @Id@
120 will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very
121 nasty loop, friends...)
123 apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
124 update arg_usage fb_ww)
128 = panic "IdInfo:apply_to_IdInfo"
131 Variant of the same thing for the typechecker.
133 applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
134 update arg_usage fb_ww)
135 = panic "IdInfo:applySubstToIdInfo"
140 -> Bool -- True <=> print specialisations, please
144 ppIdInfo sty specs_please
145 (IdInfo arity demand specenv strictness unfold update arg_usage fbtype)
147 -- order is important!:
148 ppArityInfo sty arity,
149 ppUpdateInfo sty update,
151 ppStrictnessInfo sty strictness,
154 then empty -- ToDo -- sty (not (isDataCon for_this_id))
155 -- better_id_fn inline_env (mEnvToList specenv)
158 -- DemandInfo needn't be printed since it has no effect on interfaces
159 ppDemandInfo sty demand,
160 ppFBTypeInfo sty fbtype
164 %************************************************************************
166 \subsection[arity-IdInfo]{Arity info about an @Id@}
168 %************************************************************************
172 = UnknownArity -- No idea
173 | ArityExactly Int -- Arity is exactly this
174 | ArityAtLeast Int -- Arity is this or greater
178 exactArity = ArityExactly
179 atLeastArity = ArityAtLeast
180 unknownArity = UnknownArity
182 arityInfo (IdInfo arity _ _ _ _ _ _ _) = arity
184 addArityInfo (IdInfo _ a b c d e f g) arity = IdInfo arity a b c d e f g
186 ppArityInfo sty UnknownArity = empty
187 ppArityInfo sty (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity]
188 ppArityInfo sty (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity]
191 %************************************************************************
193 \subsection[demand-IdInfo]{Demand info about an @Id@}
195 %************************************************************************
197 Whether a value is certain to be demanded or not. (This is the
198 information that is computed by the ``front-end'' of the strictness
201 This information is only used within a module, it is not exported
207 | DemandedAsPer Demand
211 noDemandInfo = UnknownDemand
213 mkDemandInfo :: Demand -> DemandInfo
214 mkDemandInfo demand = DemandedAsPer demand
216 willBeDemanded :: DemandInfo -> Bool
217 willBeDemanded (DemandedAsPer demand) = isStrict demand
218 willBeDemanded _ = False
222 demandInfo (IdInfo _ demand _ _ _ _ _ _) = demand
224 addDemandInfo (IdInfo a _ c d e f g h) demand = IdInfo a demand c d e f g h
226 ppDemandInfo PprInterface _ = empty
227 ppDemandInfo sty UnknownDemand = text "{-# L #-}"
228 ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"]
231 %************************************************************************
233 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
235 %************************************************************************
240 specInfo (IdInfo _ _ spec _ _ _ _ _) = spec
242 addSpecInfo id_info spec | isNullSpecEnv spec = id_info
243 addSpecInfo (IdInfo a b _ d e f g h) spec = IdInfo a b spec d e f g h
246 %************************************************************************
248 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
250 %************************************************************************
252 We specify the strictness of a function by giving information about
253 each of the ``wrapper's'' arguments (see the description about
254 worker/wrapper-style transformations in the PJ/Launchbury paper on
257 The list of @Demands@ specifies: (a)~the strictness properties
258 of a function's arguments; (b)~the {\em existence} of a ``worker''
259 version of the function; and (c)~the type signature of that worker (if
260 it exists); i.e. its calling convention.
266 | BottomGuaranteed -- This Id guarantees never to return;
267 -- it is bottom regardless of its arguments.
268 -- Useful for "error" and other disguised
271 | StrictnessInfo [Demand]
272 Bool -- True <=> there is a worker. There might not be, even for a
273 -- strict function, because:
274 -- (a) the function might be small enough to inline,
275 -- so no need for w/w split
276 -- (b) the strictness info might be "SSS" or something, so no w/w split.
278 -- Worker's Id, if applicable, and a list of the constructors
279 -- mentioned by the wrapper. This is necessary so that the
280 -- renamer can slurp them in. Without this info, the renamer doesn't
281 -- know which data types to slurp in concretely. Remember, for
282 -- strict things we don't put the unfolding in the interface file, to save space.
283 -- This constructor list allows the renamer to behave much as if the
284 -- unfolding *was* in the interface file.
288 mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo
290 mkStrictnessInfo xs has_wrkr
291 | all is_lazy xs = NoStrictnessInfo -- Uninteresting
292 | otherwise = StrictnessInfo xs has_wrkr
294 is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count!
295 is_lazy _ = False -- (as they imply a worker)
297 noStrictnessInfo = NoStrictnessInfo
298 mkBottomStrictnessInfo = BottomGuaranteed
300 bottomIsGuaranteed BottomGuaranteed = True
301 bottomIsGuaranteed other = False
303 strictnessInfo (IdInfo _ _ _ strict _ _ _ _) = strict
305 addStrictnessInfo id_info NoStrictnessInfo = id_info
306 addStrictnessInfo (IdInfo a b d _ e f g h) strict = IdInfo a b d strict e f g h
308 ppStrictnessInfo sty NoStrictnessInfo = empty
309 ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
311 ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
312 = hsep [ptext SLIT("_S_"), text (showList wrapper_args "")]
317 workerExists :: StrictnessInfo -> Bool
318 workerExists (StrictnessInfo _ worker_exists) = worker_exists
319 workerExists other = False
323 %************************************************************************
325 \subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
327 %************************************************************************
330 unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _) = unfolding
332 addUnfoldInfo (IdInfo a b d e _ f g h) uf = IdInfo a b d e uf f g h
335 %************************************************************************
337 \subsection[update-IdInfo]{Update-analysis info about an @Id@}
339 %************************************************************************
344 | SomeUpdateInfo UpdateSpec
346 -- we need Eq/Ord to cross-chk update infos in interfaces
348 -- the form in which we pass update-analysis info between modules:
349 type UpdateSpec = [Int]
353 mkUpdateInfo = SomeUpdateInfo
355 updateInfoMaybe NoUpdateInfo = Nothing
356 updateInfoMaybe (SomeUpdateInfo []) = Nothing
357 updateInfoMaybe (SomeUpdateInfo u) = Just u
360 Text instance so that the update annotations can be read in.
363 #ifdef REALLY_HASKELL_1_3
364 instance Read UpdateInfo where
366 instance Text UpdateInfo where
368 readsPrec p s | null s = panic "IdInfo: empty update pragma?!"
369 | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
371 ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
372 | otherwise = panic "IdInfo: not a digit while reading update pragma"
374 updateInfo (IdInfo _ _ _ _ _ update _ _) = update
376 addUpdateInfo id_info NoUpdateInfo = id_info
377 addUpdateInfo (IdInfo a b d e f _ g h) upd_info = IdInfo a b d e f upd_info g h
379 ppUpdateInfo sty NoUpdateInfo = empty
380 ppUpdateInfo sty (SomeUpdateInfo []) = empty
381 ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec))
384 %************************************************************************
386 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
388 %************************************************************************
393 | SomeArgUsageInfo ArgUsageType
394 -- ??? deriving (Eq, Ord)
396 data ArgUsage = ArgUsage Int -- number of arguments (is linear!)
398 type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB
402 mkArgUsageInfo [] = NoArgUsageInfo
403 mkArgUsageInfo au = SomeArgUsageInfo au
405 getArgUsage :: ArgUsageInfo -> ArgUsageType
406 getArgUsage NoArgUsageInfo = []
407 getArgUsage (SomeArgUsageInfo u) = u
411 argUsageInfo (IdInfo _ _ _ _ _ _ au _) = au
413 addArgUsageInfo id_info NoArgUsageInfo = id_info
414 addArgUsageInfo (IdInfo a b d e f g _ h) au_info = IdInfo a b d e f g au_info h
416 ppArgUsageInfo sty NoArgUsageInfo = empty
417 ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
419 ppArgUsage (ArgUsage n) = int n
420 ppArgUsage (UnknownArgUsage) = char '-'
422 ppArgUsageType aut = hcat
424 hcat (punctuate comma (map ppArgUsage aut)),
428 %************************************************************************
430 \subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes}
432 %************************************************************************
437 | SomeFBTypeInfo FBType
439 data FBType = FBType [FBConsum] FBProd deriving (Eq)
441 data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
442 data FBProd = FBGoodProd | FBBadProd deriving(Eq)
446 mkFBTypeInfo = SomeFBTypeInfo
448 getFBType :: FBTypeInfo -> Maybe FBType
449 getFBType NoFBTypeInfo = Nothing
450 getFBType (SomeFBTypeInfo u) = Just u
454 fbTypeInfo (IdInfo _ _ _ _ _ _ _ fb) = fb
456 addFBTypeInfo id_info NoFBTypeInfo = id_info
457 addFBTypeInfo (IdInfo a b d e f g h _) fb_info = IdInfo a b d e f g h fb_info
459 ppFBTypeInfo sty NoFBTypeInfo = empty
460 ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
461 = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod)
463 ppFBType cons prod = hcat
464 ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ])
466 ppCons FBGoodConsum = char 'G'
467 ppCons FBBadConsum = char 'B'
468 ppProd FBGoodProd = char 'G'
469 ppProd FBBadProd = char 'B'