- = IdInfo
- ArityInfo -- Its arity
-
- DemandInfo -- Whether or not it is definitely
- -- demanded
-
- SpecEnv -- Specialisations of this function which exist
-
- StrictnessInfo -- Strictness properties, notably
- -- how to conjure up "worker" functions
-
- Unfolding -- Its unfolding; for locally-defined
- -- things, this can *only* be NoUnfolding
-
- UpdateInfo -- Which args should be updated
-
- DeforestInfo -- Whether its definition should be
- -- unfolded during deforestation
-
- ArgUsageInfo -- how this Id uses its arguments
-
- FBTypeInfo -- the Foldr/Build W/W property of this function.
-
- SrcLoc -- Source location of definition
-
- -- ToDo: SrcLoc is in FullNames too (could rm?) but it
- -- is needed here too for things like ConstMethodIds and the
- -- like, which don't have full-names of their own Mind you,
- -- perhaps the Name for a constant method could give the
- -- class/type involved?
-\end{code}
-
-\begin{code}
-noIdInfo = IdInfo noInfo noInfo noInfo noInfo noInfo_UF
- noInfo noInfo noInfo noInfo mkUnknownSrcLoc
-
--- "boring" means: nothing to put in interface
-boringIdInfo (IdInfo UnknownArity
- UnknownDemand
- specenv
- strictness
- unfolding
- NoUpdateInfo
- Don'tDeforest
- _ {- arg_usage: currently no interface effect -}
- _ {- no f/b w/w -}
- _ {- src_loc: no effect on interfaces-}
- )
- | isNullSpecEnv specenv
- && boring_strictness strictness
- && boring_unfolding unfolding
- = True
- where
- boring_strictness NoStrictnessInfo = True
- boring_strictness BottomGuaranteed = False
- boring_strictness (StrictnessInfo wrap_args _) = all_present_WwLazies wrap_args
-
- boring_unfolding NoUnfolding = True
- boring_unfolding _ = False
-
-boringIdInfo _ = False
-
-pp_NONE = ppPStr SLIT("_N_")
-\end{code}
-
-Simply turgid. But BE CAREFUL: don't @apply_to_Id@ if that @Id@
-will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very
-nasty loop, friends...)
-\begin{code}
-apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
- update deforest arg_usage fb_ww srcloc)
- | isNullSpecEnv spec
- = idinfo
- | otherwise
- = panic "IdInfo:apply_to_IdInfo"
-{- LATER:
- let
- new_spec = apply_spec spec
-
- -- NOT a good idea:
- -- apply_strict strictness `thenLft` \ new_strict ->
- -- apply_wrap wrap `thenLft` \ new_wrap ->
- in
- IdInfo arity demand new_spec strictness unfold
- update deforest arg_usage fb_ww srcloc
- where
- apply_spec (SpecEnv is)
- = SpecEnv (map do_one is)
- where
- do_one (SpecInfo ty_maybes ds spec_id)
- = --apply_to_Id ty_fn spec_id `thenLft` \ new_spec_id ->
- SpecInfo (map apply_to_maybe ty_maybes) ds spec_id
- where
- apply_to_maybe Nothing = Nothing
- apply_to_maybe (Just ty) = Just (ty_fn ty)
--}
-
-{- NOT a good idea;
- apply_strict info@NoStrictnessInfo = returnLft info
- apply_strict BottomGuaranteed = ???
- apply_strict (StrictnessInfo wrap_arg_info id_maybe)
- = (case id_maybe of
- Nothing -> returnLft Nothing
- Just xx -> applySubstToId subst xx `thenLft` \ new_xx ->
- returnLft (Just new_xx)
- ) `thenLft` \ new_id_maybe ->
- returnLft (StrictnessInfo wrap_arg_info new_id_maybe)
--}
-\end{code}
-
-Variant of the same thing for the typechecker.
-\begin{code}
-applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
- update deforest arg_usage fb_ww srcloc)
- = panic "IdInfo:applySubstToIdInfo"
-{- LATER:
- case (apply_spec s0 spec) of { (s1, new_spec) ->
- (s1, IdInfo arity demand new_spec strictness unfold update deforest arg_usage fb_ww srcloc) }
- where
- apply_spec s0 (SpecEnv is)
- = case (mapAccumL do_one s0 is) of { (s1, new_is) ->
- (s1, SpecEnv new_is) }
- where
- do_one s0 (SpecInfo ty_maybes ds spec_id)
- = case (mapAccumL apply_to_maybe s0 ty_maybes) of { (s1, new_maybes) ->
- (s1, SpecInfo new_maybes ds spec_id) }
- where
- apply_to_maybe s0 Nothing = (s0, Nothing)
- apply_to_maybe s0 (Just ty)
- = case (applySubstToTy s0 ty) of { (s1, new_ty) ->
- (s1, Just new_ty) }
--}
-\end{code}
-
-\begin{code}
-ppIdInfo :: PprStyle
- -> Id -- The Id for which we're printing this IdInfo
- -> Bool -- True <=> print specialisations, please
- -> (Id -> Id) -- to look up "better Ids" w/ better IdInfos;
- -> IdEnv Unfolding
- -- inlining info for top-level fns in this module
- -> IdInfo -- see MkIface notes
- -> Pretty
-
-ppIdInfo sty for_this_id specs_please better_id_fn inline_env
- i@(IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype srcloc)
- | boringIdInfo i
- = ppPStr SLIT("_NI_")
-
- | otherwise
- = let
- stuff = ppCat [
- -- order is important!:
- ppInfo sty better_id_fn arity,
- ppInfo sty better_id_fn update,
- ppInfo sty better_id_fn deforest,
-
- pp_strictness sty (Just for_this_id)
- better_id_fn inline_env strictness,
-
- if bottomIsGuaranteed strictness
- then pp_NONE
- else pp_unfolding sty for_this_id inline_env unfold,
-
- if specs_please
- then panic "ppSpecs (ToDo)" -- sty (not (isDataCon for_this_id))
- -- better_id_fn inline_env (mEnvToList specenv)
- else pp_NONE,
-
- -- DemandInfo needn't be printed since it has no effect on interfaces
- ppInfo sty better_id_fn demand,
- ppInfo sty better_id_fn fbtype
- ]
- in
- case sty of
- PprInterface -> if opt_OmitInterfacePragmas
- then ppNil
- else stuff
- _ -> stuff
+ = IdInfo {
+ arityInfo :: ArityInfo, -- Its arity
+ demandInfo :: Demand, -- Whether or not it is definitely demanded
+ specInfo :: IdSpecEnv, -- Specialisations of this function which exist
+ strictnessInfo :: StrictnessInfo, -- Strictness properties
+ unfoldingInfo :: Unfolding, -- Its unfolding
+ updateInfo :: UpdateInfo, -- Which args should be updated
+ cafInfo :: CafInfo,
+ inlinePragInfo :: !InlinePragInfo -- Inline pragmas
+ }
+\end{code}
+
+Setters
+
+\begin{code}
+setUpdateInfo ud info = info { updateInfo = ud }
+setDemandInfo dd info = info { demandInfo = dd }
+setStrictnessInfo st info = info { strictnessInfo = st }
+setSpecInfo sp info = info { specInfo = sp }
+setArityInfo ar info = info { arityInfo = ar }
+setInlinePragInfo pr info = info { inlinePragInfo = pr }
+setUnfoldingInfo uf info = info { unfoldingInfo = uf }
+setCafInfo cf info = info { cafInfo = cf }
+\end{code}
+
+
+\begin{code}
+noIdInfo = IdInfo {
+ arityInfo = UnknownArity,
+ demandInfo = wwLazy,
+ specInfo = emptySpecEnv,
+ strictnessInfo = NoStrictnessInfo,
+ unfoldingInfo = noUnfolding,
+ updateInfo = NoUpdateInfo,
+ cafInfo = MayHaveCafRefs,
+ inlinePragInfo = NoInlinePragInfo
+ }
+\end{code}
+
+\begin{code}
+ppIdInfo :: IdInfo -> SDoc
+ppIdInfo (IdInfo {arityInfo,
+ demandInfo,
+ specInfo,
+ strictnessInfo,
+ unfoldingInfo,
+ updateInfo,
+ cafInfo,
+ inlinePragInfo})
+ = hsep [
+ ppArityInfo arityInfo,
+ ppUpdateInfo updateInfo,
+ ppStrictnessInfo strictnessInfo,
+ ppr demandInfo,
+ ppCafInfo cafInfo
+ -- Inline pragma printed out with all binders; see PprCore.pprIdBndr
+ ]