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(..), -- Non-abstract
28 wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
32 mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
33 strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
35 unfoldInfo, addUnfoldInfo,
37 specInfo, addSpecInfo,
39 UpdateInfo, SYN_IE(UpdateSpec),
40 mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
43 deforestInfo, ppDeforestInfo, addDeforestInfo,
45 ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType),
46 mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
48 FBTypeInfo, FBType(..), FBConsum(..), FBProd(..),
49 fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType
53 IMPORT_1_3(Char(toLower))
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 Type ( eqSimpleTy, splitFunTyExpandingDicts )
61 import CmdLineOpts ( opt_OmitInterfacePragmas )
64 import Maybes ( firstJust )
65 import Outputable ( ifPprInterface, Outputable(..){-instances-} )
66 import PprStyle ( PprStyle(..) )
68 import Unique ( pprUnique )
69 import Util ( mapAccumL, panic, assertPanic, pprPanic )
71 #ifdef REALLY_HASKELL_1_3
72 ord = fromEnum :: Char -> Int
75 applySubstToTy = panic "IdInfo.applySubstToTy"
76 showTypeCategory = panic "IdInfo.showTypeCategory"
79 An @IdInfo@ gives {\em optional} information about an @Id@. If
80 present it never lies, but it may not be present, in which case there
81 is always a conservative assumption which can be made.
83 Two @Id@s may have different info even though they have the same
84 @Unique@ (and are hence the same @Id@); for example, one might lack
85 the properties attached to the other.
87 The @IdInfo@ gives information about the value, or definition, of the
88 @Id@. It does {\em not} contain information about the @Id@'s usage
89 (except for @DemandInfo@? ToDo).
94 ArityInfo -- Its arity
96 DemandInfo -- Whether or not it is definitely
100 -- Specialisations of this function which exist
103 -- Strictness properties, notably
104 -- how to conjure up "worker" functions
107 -- Its unfolding; for locally-defined
108 -- things, this can *only* be NoUnfolding
110 UpdateInfo -- Which args should be updated
112 DeforestInfo -- Whether its definition should be
113 -- unfolded during deforestation
115 ArgUsageInfo -- how this Id uses its arguments
117 FBTypeInfo -- the Foldr/Build W/W property of this function.
121 noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding
122 NoUpdateInfo Don'tDeforest NoArgUsageInfo NoFBTypeInfo
125 Simply turgid. But BE CAREFUL: don't @apply_to_Id@ if that @Id@
126 will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very
127 nasty loop, friends...)
129 apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
130 update deforest arg_usage fb_ww)
134 = panic "IdInfo:apply_to_IdInfo"
137 new_spec = apply_spec spec
140 -- apply_strict strictness `thenLft` \ new_strict ->
141 -- apply_wrap wrap `thenLft` \ new_wrap ->
143 IdInfo arity demand new_spec strictness unfold
144 update deforest arg_usage fb_ww
146 apply_spec (SpecEnv is)
147 = SpecEnv (map do_one is)
149 do_one (SpecInfo ty_maybes ds spec_id)
150 = --apply_to_Id ty_fn spec_id `thenLft` \ new_spec_id ->
151 SpecInfo (map apply_to_maybe ty_maybes) ds spec_id
153 apply_to_maybe Nothing = Nothing
154 apply_to_maybe (Just ty) = Just (ty_fn ty)
158 apply_strict info@NoStrictnessInfo = returnLft info
159 apply_strict BottomGuaranteed = ???
160 apply_strict (StrictnessInfo wrap_arg_info id_maybe)
162 Nothing -> returnLft Nothing
163 Just xx -> applySubstToId subst xx `thenLft` \ new_xx ->
164 returnLft (Just new_xx)
165 ) `thenLft` \ new_id_maybe ->
166 returnLft (StrictnessInfo wrap_arg_info new_id_maybe)
170 Variant of the same thing for the typechecker.
172 applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
173 update deforest arg_usage fb_ww)
174 = panic "IdInfo:applySubstToIdInfo"
176 case (apply_spec s0 spec) of { (s1, new_spec) ->
177 (s1, IdInfo arity demand new_spec strictness unfold update deforest arg_usage fb_ww) }
179 apply_spec s0 (SpecEnv is)
180 = case (mapAccumL do_one s0 is) of { (s1, new_is) ->
181 (s1, SpecEnv new_is) }
183 do_one s0 (SpecInfo ty_maybes ds spec_id)
184 = case (mapAccumL apply_to_maybe s0 ty_maybes) of { (s1, new_maybes) ->
185 (s1, SpecInfo new_maybes ds spec_id) }
187 apply_to_maybe s0 Nothing = (s0, Nothing)
188 apply_to_maybe s0 (Just ty)
189 = case (applySubstToTy s0 ty) of { (s1, new_ty) ->
196 -> Bool -- True <=> print specialisations, please
200 ppIdInfo sty specs_please
201 (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype)
203 -- order is important!:
204 ppArityInfo sty arity,
205 ppUpdateInfo sty update,
206 ppDeforestInfo sty deforest,
208 ppStrictnessInfo sty strictness,
211 then empty -- ToDo -- sty (not (isDataCon for_this_id))
212 -- better_id_fn inline_env (mEnvToList specenv)
215 -- DemandInfo needn't be printed since it has no effect on interfaces
216 ppDemandInfo sty demand,
217 ppFBTypeInfo sty fbtype
221 %************************************************************************
223 \subsection[arity-IdInfo]{Arity info about an @Id@}
225 %************************************************************************
229 = UnknownArity -- No idea
230 | ArityExactly Int -- Arity is exactly this
231 | ArityAtLeast Int -- Arity is this or greater
235 exactArity = ArityExactly
236 atLeastArity = ArityAtLeast
237 unknownArity = UnknownArity
239 arityInfo (IdInfo arity _ _ _ _ _ _ _ _) = arity
241 addArityInfo (IdInfo _ a c d e f g h i) arity = IdInfo arity a c d e f g h i
243 ppArityInfo sty UnknownArity = empty
244 ppArityInfo sty (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity]
245 ppArityInfo sty (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity]
248 %************************************************************************
250 \subsection[demand-IdInfo]{Demand info about an @Id@}
252 %************************************************************************
254 Whether a value is certain to be demanded or not. (This is the
255 information that is computed by the ``front-end'' of the strictness
258 This information is only used within a module, it is not exported
264 | DemandedAsPer Demand
268 noDemandInfo = UnknownDemand
270 mkDemandInfo :: Demand -> DemandInfo
271 mkDemandInfo demand = DemandedAsPer demand
273 willBeDemanded :: DemandInfo -> Bool
274 willBeDemanded (DemandedAsPer demand) = isStrict demand
275 willBeDemanded _ = False
279 demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand
281 addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i
283 ppDemandInfo PprInterface _ = empty
284 ppDemandInfo sty UnknownDemand = text "{-# L #-}"
285 ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"]
288 %************************************************************************
290 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
292 %************************************************************************
297 specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec
299 addSpecInfo id_info spec | isNullSpecEnv spec = id_info
300 addSpecInfo (IdInfo a b _ d e f g h i) spec = IdInfo a b spec d e f g h i
303 %************************************************************************
305 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
307 %************************************************************************
309 We specify the strictness of a function by giving information about
310 each of the ``wrapper's'' arguments (see the description about
311 worker/wrapper-style transformations in the PJ/Launchbury paper on
314 The list of @Demands@ specifies: (a)~the strictness properties
315 of a function's arguments; (b)~the {\em existence} of a ``worker''
316 version of the function; and (c)~the type signature of that worker (if
317 it exists); i.e. its calling convention.
320 data StrictnessInfo bdee
323 | BottomGuaranteed -- This Id guarantees never to return;
324 -- it is bottom regardless of its arguments.
325 -- Useful for "error" and other disguised
328 | StrictnessInfo [Demand] -- The main stuff; see below.
329 (Maybe bdee) -- Worker's Id, if applicable.
330 -- (It may not be applicable because the strictness info
331 -- might say just "SSS" or something; so there's no w/w split.)
335 mkStrictnessInfo :: [Demand] -> Maybe bdee -> StrictnessInfo bdee
337 mkStrictnessInfo xs wrkr
338 | all is_lazy xs = NoStrictnessInfo -- Uninteresting
339 | otherwise = StrictnessInfo xs wrkr
341 is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count!
342 is_lazy _ = False -- (as they imply a worker)
344 noStrictnessInfo = NoStrictnessInfo
345 mkBottomStrictnessInfo = BottomGuaranteed
347 bottomIsGuaranteed BottomGuaranteed = True
348 bottomIsGuaranteed other = False
350 strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict
352 addStrictnessInfo id_info NoStrictnessInfo = id_info
353 addStrictnessInfo (IdInfo a b d _ e f g h i) strict = IdInfo a b d strict e f g h i
355 ppStrictnessInfo sty NoStrictnessInfo = empty
356 ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
358 ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
359 = hsep [ptext SLIT("_S_"), text (showList wrapper_args ""), pp_wrkr]
361 pp_wrkr = case wrkr_maybe of
363 Just wrkr -> ppr sty wrkr
368 workerExists :: StrictnessInfo bdee -> Bool
369 workerExists (StrictnessInfo _ (Just worker_id)) = True
370 workerExists other = False
372 getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee
373 getWorkerId_maybe (StrictnessInfo _ maybe_worker_id) = maybe_worker_id
374 getWorkerId_maybe other = Nothing
378 %************************************************************************
380 \subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
382 %************************************************************************
385 unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding
387 addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i
390 %************************************************************************
392 \subsection[update-IdInfo]{Update-analysis info about an @Id@}
394 %************************************************************************
399 | SomeUpdateInfo UpdateSpec
401 -- we need Eq/Ord to cross-chk update infos in interfaces
403 -- the form in which we pass update-analysis info between modules:
404 type UpdateSpec = [Int]
408 mkUpdateInfo = SomeUpdateInfo
410 updateInfoMaybe NoUpdateInfo = Nothing
411 updateInfoMaybe (SomeUpdateInfo []) = Nothing
412 updateInfoMaybe (SomeUpdateInfo u) = Just u
415 Text instance so that the update annotations can be read in.
418 #ifdef REALLY_HASKELL_1_3
419 instance Read UpdateInfo where
421 instance Text UpdateInfo where
423 readsPrec p s | null s = panic "IdInfo: empty update pragma?!"
424 | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
426 ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
427 | otherwise = panic "IdInfo: not a digit while reading update pragma"
429 updateInfo (IdInfo _ _ _ _ _ update _ _ _) = update
431 addUpdateInfo id_info NoUpdateInfo = id_info
432 addUpdateInfo (IdInfo a b d e f _ g h i) upd_info = IdInfo a b d e f upd_info g h i
434 ppUpdateInfo sty NoUpdateInfo = empty
435 ppUpdateInfo sty (SomeUpdateInfo []) = empty
436 ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec))
439 %************************************************************************
441 \subsection[deforest-IdInfo]{Deforestation info about an @Id@}
443 %************************************************************************
445 The deforest info says whether this Id is to be unfolded during
446 deforestation. Therefore, when the deforest pragma is true, we must
447 also have the unfolding information available for this Id.
451 = Don'tDeforest -- just a bool, might extend this
452 | DoDeforest -- later.
453 -- deriving (Eq, Ord)
457 deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest
459 addDeforestInfo id_info Don'tDeforest = id_info
460 addDeforestInfo (IdInfo a b d e f g _ h i) deforest = IdInfo a b d e f g deforest h i
462 ppDeforestInfo sty Don'tDeforest = empty
463 ppDeforestInfo sty DoDeforest = ptext SLIT("_DEFOREST_")
466 %************************************************************************
468 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
470 %************************************************************************
475 | SomeArgUsageInfo ArgUsageType
476 -- ??? deriving (Eq, Ord)
478 data ArgUsage = ArgUsage Int -- number of arguments (is linear!)
480 type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB
484 mkArgUsageInfo [] = NoArgUsageInfo
485 mkArgUsageInfo au = SomeArgUsageInfo au
487 getArgUsage :: ArgUsageInfo -> ArgUsageType
488 getArgUsage NoArgUsageInfo = []
489 getArgUsage (SomeArgUsageInfo u) = u
493 argUsageInfo (IdInfo _ _ _ _ _ _ _ au _) = au
495 addArgUsageInfo id_info NoArgUsageInfo = id_info
496 addArgUsageInfo (IdInfo a b d e f g h _ i) au_info = IdInfo a b d e f g h au_info i
498 ppArgUsageInfo sty NoArgUsageInfo = empty
499 ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
501 ppArgUsage (ArgUsage n) = int n
502 ppArgUsage (UnknownArgUsage) = char '-'
504 ppArgUsageType aut = hcat
506 hcat (punctuate comma (map ppArgUsage aut)),
510 %************************************************************************
512 \subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes}
514 %************************************************************************
519 | SomeFBTypeInfo FBType
521 data FBType = FBType [FBConsum] FBProd deriving (Eq)
523 data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
524 data FBProd = FBGoodProd | FBBadProd deriving(Eq)
528 mkFBTypeInfo = SomeFBTypeInfo
530 getFBType :: FBTypeInfo -> Maybe FBType
531 getFBType NoFBTypeInfo = Nothing
532 getFBType (SomeFBTypeInfo u) = Just u
536 fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb
538 addFBTypeInfo id_info NoFBTypeInfo = id_info
539 addFBTypeInfo (IdInfo a b d e f g h i _) fb_info = IdInfo a b d e f g h i fb_info
541 ppFBTypeInfo sty NoFBTypeInfo = empty
542 ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
543 = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod)
545 ppFBType cons prod = hcat
546 ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ])
548 ppCons FBGoodConsum = char 'G'
549 ppCons FBBadConsum = char 'B'
550 ppProd FBGoodProd = char 'G'
551 ppProd FBBadProd = char 'B'