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
31 mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
32 strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
34 unfoldInfo, addUnfoldInfo,
36 specInfo, addSpecInfo,
38 UpdateInfo, SYN_IE(UpdateSpec),
39 mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
42 deforestInfo, ppDeforestInfo, addDeforestInfo,
44 ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType),
45 mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
47 FBTypeInfo, FBType(..), FBConsum(..), FBProd(..),
48 fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType
52 IMPORT_1_3(Char(toLower))
54 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
55 IMPORT_DELOOPER(IdLoop) -- IdInfo is a dependency-loop ranch, and
56 -- we break those loops by using IdLoop and
57 -- *not* importing much of anything else,
58 -- except from the very general "utils".
60 import {-# SOURCE #-} SpecEnv
61 import {-# SOURCE #-} Id
62 import {-# SOURCE #-} CoreUnfold
63 import {-# SOURCE #-} StdIdInfo
66 import Type ( eqSimpleTy, splitFunTyExpandingDicts )
67 import BasicTypes ( NewOrData )
68 import CmdLineOpts ( opt_OmitInterfacePragmas )
71 import Maybes ( firstJust )
72 import Outputable ( ifaceStyle, PprStyle(..), Outputable(..){-instances-} )
75 import Unique ( pprUnique )
76 import Util ( mapAccumL, panic, assertPanic, pprPanic )
78 #ifdef REALLY_HASKELL_1_3
79 ord = fromEnum :: Char -> Int
82 applySubstToTy = panic "IdInfo.applySubstToTy"
83 showTypeCategory = panic "IdInfo.showTypeCategory"
86 An @IdInfo@ gives {\em optional} information about an @Id@. If
87 present it never lies, but it may not be present, in which case there
88 is always a conservative assumption which can be made.
90 Two @Id@s may have different info even though they have the same
91 @Unique@ (and are hence the same @Id@); for example, one might lack
92 the properties attached to the other.
94 The @IdInfo@ gives information about the value, or definition, of the
95 @Id@. It does {\em not} contain information about the @Id@'s usage
96 (except for @DemandInfo@? ToDo).
101 ArityInfo -- Its arity
103 DemandInfo -- Whether or not it is definitely
107 -- Specialisations of this function which exist
110 -- Strictness properties, notably
111 -- how to conjure up "worker" functions
114 -- Its unfolding; for locally-defined
115 -- things, this can *only* be NoUnfolding
117 UpdateInfo -- Which args should be updated
119 DeforestInfo -- Whether its definition should be
120 -- unfolded during deforestation
122 ArgUsageInfo -- how this Id uses its arguments
124 FBTypeInfo -- the Foldr/Build W/W property of this function.
128 noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding
129 NoUpdateInfo Don'tDeforest NoArgUsageInfo NoFBTypeInfo
132 Simply turgid. But BE CAREFUL: don't @apply_to_Id@ if that @Id@
133 will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very
134 nasty loop, friends...)
136 apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
137 update deforest arg_usage fb_ww)
141 = panic "IdInfo:apply_to_IdInfo"
144 new_spec = apply_spec spec
147 -- apply_strict strictness `thenLft` \ new_strict ->
148 -- apply_wrap wrap `thenLft` \ new_wrap ->
150 IdInfo arity demand new_spec strictness unfold
151 update deforest arg_usage fb_ww
153 apply_spec (SpecEnv is)
154 = SpecEnv (map do_one is)
156 do_one (SpecInfo ty_maybes ds spec_id)
157 = --apply_to_Id ty_fn spec_id `thenLft` \ new_spec_id ->
158 SpecInfo (map apply_to_maybe ty_maybes) ds spec_id
160 apply_to_maybe Nothing = Nothing
161 apply_to_maybe (Just ty) = Just (ty_fn ty)
165 apply_strict info@NoStrictnessInfo = returnLft info
166 apply_strict BottomGuaranteed = ???
167 apply_strict (StrictnessInfo wrap_arg_info id_maybe)
169 Nothing -> returnLft Nothing
170 Just xx -> applySubstToId subst xx `thenLft` \ new_xx ->
171 returnLft (Just new_xx)
172 ) `thenLft` \ new_id_maybe ->
173 returnLft (StrictnessInfo wrap_arg_info new_id_maybe)
177 Variant of the same thing for the typechecker.
179 applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
180 update deforest arg_usage fb_ww)
181 = panic "IdInfo:applySubstToIdInfo"
183 case (apply_spec s0 spec) of { (s1, new_spec) ->
184 (s1, IdInfo arity demand new_spec strictness unfold update deforest arg_usage fb_ww) }
186 apply_spec s0 (SpecEnv is)
187 = case (mapAccumL do_one s0 is) of { (s1, new_is) ->
188 (s1, SpecEnv new_is) }
190 do_one s0 (SpecInfo ty_maybes ds spec_id)
191 = case (mapAccumL apply_to_maybe s0 ty_maybes) of { (s1, new_maybes) ->
192 (s1, SpecInfo new_maybes ds spec_id) }
194 apply_to_maybe s0 Nothing = (s0, Nothing)
195 apply_to_maybe s0 (Just ty)
196 = case (applySubstToTy s0 ty) of { (s1, new_ty) ->
203 -> Bool -- True <=> print specialisations, please
207 ppIdInfo sty specs_please
208 (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype)
210 -- order is important!:
211 ppArityInfo sty arity,
212 ppUpdateInfo sty update,
213 ppDeforestInfo sty deforest,
215 ppStrictnessInfo sty strictness,
218 then empty -- ToDo -- sty (not (isDataCon for_this_id))
219 -- better_id_fn inline_env (mEnvToList specenv)
222 -- DemandInfo needn't be printed since it has no effect on interfaces
223 ppDemandInfo sty demand,
224 ppFBTypeInfo sty fbtype
228 %************************************************************************
230 \subsection[arity-IdInfo]{Arity info about an @Id@}
232 %************************************************************************
236 = UnknownArity -- No idea
237 | ArityExactly Int -- Arity is exactly this
238 | ArityAtLeast Int -- Arity is this or greater
242 exactArity = ArityExactly
243 atLeastArity = ArityAtLeast
244 unknownArity = UnknownArity
246 arityInfo (IdInfo arity _ _ _ _ _ _ _ _) = arity
248 addArityInfo (IdInfo _ a c d e f g h i) arity = IdInfo arity a c d e f g h i
250 ppArityInfo sty UnknownArity = empty
251 ppArityInfo sty (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity]
252 ppArityInfo sty (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity]
255 %************************************************************************
257 \subsection[demand-IdInfo]{Demand info about an @Id@}
259 %************************************************************************
261 Whether a value is certain to be demanded or not. (This is the
262 information that is computed by the ``front-end'' of the strictness
265 This information is only used within a module, it is not exported
271 | DemandedAsPer Demand
275 noDemandInfo = UnknownDemand
277 mkDemandInfo :: Demand -> DemandInfo
278 mkDemandInfo demand = DemandedAsPer demand
280 willBeDemanded :: DemandInfo -> Bool
281 willBeDemanded (DemandedAsPer demand) = isStrict demand
282 willBeDemanded _ = False
286 demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand
288 addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i
290 ppDemandInfo PprInterface _ = empty
291 ppDemandInfo sty UnknownDemand = text "{-# L #-}"
292 ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"]
295 %************************************************************************
297 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
299 %************************************************************************
304 specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec
306 addSpecInfo id_info spec | isNullSpecEnv spec = id_info
307 addSpecInfo (IdInfo a b _ d e f g h i) spec = IdInfo a b spec d e f g h i
310 %************************************************************************
312 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
314 %************************************************************************
316 We specify the strictness of a function by giving information about
317 each of the ``wrapper's'' arguments (see the description about
318 worker/wrapper-style transformations in the PJ/Launchbury paper on
321 The list of @Demands@ specifies: (a)~the strictness properties
322 of a function's arguments; (b)~the {\em existence} of a ``worker''
323 version of the function; and (c)~the type signature of that worker (if
324 it exists); i.e. its calling convention.
327 data StrictnessInfo bdee
330 | BottomGuaranteed -- This Id guarantees never to return;
331 -- it is bottom regardless of its arguments.
332 -- Useful for "error" and other disguised
335 | StrictnessInfo [Demand] -- The main stuff; see below.
336 (Maybe (bdee,[bdee])) -- Worker's Id, if applicable, and a list of the constructors
337 -- mentioned by the wrapper. This is necessary so that the
338 -- renamer can slurp them in. Without this info, the renamer doesn't
339 -- know which data types to slurp in concretely. Remember, for
340 -- strict things we don't put the unfolding in the interface file, to save space.
341 -- This constructor list allows the renamer to behave much as if the
342 -- unfolding *was* in the interface file.
344 -- This field might be Nothing even for a strict fn because the strictness info
345 -- might say just "SSS" or something; so there's no w/w split.
349 mkStrictnessInfo :: [Demand] -> Maybe (bdee,[bdee]) -> StrictnessInfo bdee
351 mkStrictnessInfo xs wrkr
352 | all is_lazy xs = NoStrictnessInfo -- Uninteresting
353 | otherwise = StrictnessInfo xs wrkr
355 is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count!
356 is_lazy _ = False -- (as they imply a worker)
358 noStrictnessInfo = NoStrictnessInfo
359 mkBottomStrictnessInfo = BottomGuaranteed
361 bottomIsGuaranteed BottomGuaranteed = True
362 bottomIsGuaranteed other = False
364 strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict
366 addStrictnessInfo id_info NoStrictnessInfo = id_info
367 addStrictnessInfo (IdInfo a b d _ e f g h i) strict = IdInfo a b d strict e f g h i
369 ppStrictnessInfo sty NoStrictnessInfo = empty
370 ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
372 ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
373 = hsep [ptext SLIT("_S_"), text (showList wrapper_args ""), pp_wrkr]
375 pp_wrkr = case wrkr_maybe of
377 Just (wrkr,cons) | ifaceStyle sty &&
378 not (null cons) -> pprId sty wrkr <+> braces (hsep (map (pprId sty) cons))
379 | otherwise -> pprId sty wrkr
384 workerExists :: StrictnessInfo bdee -> Bool
385 workerExists (StrictnessInfo _ (Just worker_id)) = True
386 workerExists other = False
388 getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee
389 getWorkerId_maybe (StrictnessInfo _ (Just (wrkr,_))) = Just wrkr
390 getWorkerId_maybe other = Nothing
394 %************************************************************************
396 \subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
398 %************************************************************************
401 unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding
403 addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i
406 %************************************************************************
408 \subsection[update-IdInfo]{Update-analysis info about an @Id@}
410 %************************************************************************
415 | SomeUpdateInfo UpdateSpec
417 -- we need Eq/Ord to cross-chk update infos in interfaces
419 -- the form in which we pass update-analysis info between modules:
420 type UpdateSpec = [Int]
424 mkUpdateInfo = SomeUpdateInfo
426 updateInfoMaybe NoUpdateInfo = Nothing
427 updateInfoMaybe (SomeUpdateInfo []) = Nothing
428 updateInfoMaybe (SomeUpdateInfo u) = Just u
431 Text instance so that the update annotations can be read in.
434 #ifdef REALLY_HASKELL_1_3
435 instance Read UpdateInfo where
437 instance Text UpdateInfo where
439 readsPrec p s | null s = panic "IdInfo: empty update pragma?!"
440 | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
442 ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
443 | otherwise = panic "IdInfo: not a digit while reading update pragma"
445 updateInfo (IdInfo _ _ _ _ _ update _ _ _) = update
447 addUpdateInfo id_info NoUpdateInfo = id_info
448 addUpdateInfo (IdInfo a b d e f _ g h i) upd_info = IdInfo a b d e f upd_info g h i
450 ppUpdateInfo sty NoUpdateInfo = empty
451 ppUpdateInfo sty (SomeUpdateInfo []) = empty
452 ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec))
455 %************************************************************************
457 \subsection[deforest-IdInfo]{Deforestation info about an @Id@}
459 %************************************************************************
461 The deforest info says whether this Id is to be unfolded during
462 deforestation. Therefore, when the deforest pragma is true, we must
463 also have the unfolding information available for this Id.
467 = Don'tDeforest -- just a bool, might extend this
468 | DoDeforest -- later.
469 -- deriving (Eq, Ord)
473 deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest
475 addDeforestInfo id_info Don'tDeforest = id_info
476 addDeforestInfo (IdInfo a b d e f g _ h i) deforest = IdInfo a b d e f g deforest h i
478 ppDeforestInfo sty Don'tDeforest = empty
479 ppDeforestInfo sty DoDeforest = ptext SLIT("_DEFOREST_")
482 %************************************************************************
484 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
486 %************************************************************************
491 | SomeArgUsageInfo ArgUsageType
492 -- ??? deriving (Eq, Ord)
494 data ArgUsage = ArgUsage Int -- number of arguments (is linear!)
496 type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB
500 mkArgUsageInfo [] = NoArgUsageInfo
501 mkArgUsageInfo au = SomeArgUsageInfo au
503 getArgUsage :: ArgUsageInfo -> ArgUsageType
504 getArgUsage NoArgUsageInfo = []
505 getArgUsage (SomeArgUsageInfo u) = u
509 argUsageInfo (IdInfo _ _ _ _ _ _ _ au _) = au
511 addArgUsageInfo id_info NoArgUsageInfo = id_info
512 addArgUsageInfo (IdInfo a b d e f g h _ i) au_info = IdInfo a b d e f g h au_info i
514 ppArgUsageInfo sty NoArgUsageInfo = empty
515 ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
517 ppArgUsage (ArgUsage n) = int n
518 ppArgUsage (UnknownArgUsage) = char '-'
520 ppArgUsageType aut = hcat
522 hcat (punctuate comma (map ppArgUsage aut)),
526 %************************************************************************
528 \subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes}
530 %************************************************************************
535 | SomeFBTypeInfo FBType
537 data FBType = FBType [FBConsum] FBProd deriving (Eq)
539 data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
540 data FBProd = FBGoodProd | FBBadProd deriving(Eq)
544 mkFBTypeInfo = SomeFBTypeInfo
546 getFBType :: FBTypeInfo -> Maybe FBType
547 getFBType NoFBTypeInfo = Nothing
548 getFBType (SomeFBTypeInfo u) = Just u
552 fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb
554 addFBTypeInfo id_info NoFBTypeInfo = id_info
555 addFBTypeInfo (IdInfo a b d e f g h i _) fb_info = IdInfo a b d e f g h i fb_info
557 ppFBTypeInfo sty NoFBTypeInfo = empty
558 ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
559 = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod)
561 ppFBType cons prod = hcat
562 ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ])
564 ppCons FBGoodConsum = char 'G'
565 ppCons FBBadConsum = char 'B'
566 ppProd FBGoodProd = char 'G'
567 ppProd FBBadProd = char 'B'