mkDemandInfo,
willBeDemanded,
- MatchEnv, -- the SpecEnv
StrictnessInfo(..), -- non-abstract
Demand(..), -- non-abstract
UpdateInfo,
mkUpdateInfo,
- UpdateSpec(..),
+ SYN_IE(UpdateSpec),
updateInfoMaybe,
DeforestInfo(..),
ArgUsageInfo,
ArgUsage(..),
- ArgUsageType(..),
+ SYN_IE(ArgUsageType),
mkArgUsageInfo,
getArgUsage,
) where
IMP_Ubiq()
+IMPORT_1_3(Char(toLower))
-IMPORT_DELOOPER(IdLoop) -- IdInfo is a dependency-loop ranch, and
+IMPORT_DELOOPER(IdLoop) -- IdInfo is a dependency-loop ranch, and
-- we break those loops by using IdLoop and
-- *not* importing much of anything else,
-- except from the very general "utils".
import CmdLineOpts ( opt_OmitInterfacePragmas )
import Maybes ( firstJust )
-import MatchEnv ( nullMEnv, isEmptyMEnv, mEnvToList )
-import OccurAnal ( occurAnalyseGlobalExpr )
import Outputable ( ifPprInterface, Outputable(..){-instances-} )
import PprStyle ( PprStyle(..) )
import Pretty
import SrcLoc ( mkUnknownSrcLoc )
import Type ( eqSimpleTy, splitFunTyExpandingDicts )
+import Unique ( pprUnique )
import Util ( mapAccumL, panic, assertPanic, pprPanic )
#ifdef REALLY_HASKELL_1_3
DemandInfo -- Whether or not it is definitely
-- demanded
- (MatchEnv [Type] CoreExpr)
- -- Specialisations of this function which exist
- -- This corresponds to a SpecEnv which we do
- -- not import directly to avoid loop
+ SpecEnv -- Specialisations of this function which exist
StrictnessInfo -- Strictness properties, notably
-- how to conjure up "worker" functions
- UnfoldingDetails -- Its unfolding; for locally-defined
- -- things, this can *only* be NoUnfoldingDetails
+ Unfolding -- Its unfolding; for locally-defined
+ -- things, this can *only* be NoUnfolding
UpdateInfo -- Which args should be updated
_ {- no f/b w/w -}
_ {- src_loc: no effect on interfaces-}
)
- | null (mEnvToList specenv)
+ | isNullSpecEnv specenv
&& boring_strictness strictness
&& boring_unfolding unfolding
= True
boring_strictness BottomGuaranteed = False
boring_strictness (StrictnessInfo wrap_args _) = all_present_WwLazies wrap_args
- boring_unfolding NoUnfoldingDetails = True
- boring_unfolding _ = False
+ boring_unfolding NoUnfolding = True
+ boring_unfolding _ = False
boringIdInfo _ = False
\begin{code}
apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
update deforest arg_usage fb_ww srcloc)
- | isEmptyMEnv spec
+ | isNullSpecEnv spec
= idinfo
| otherwise
= panic "IdInfo:apply_to_IdInfo"
-> 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 UnfoldingDetails
+ -> IdEnv Unfolding
-- inlining info for top-level fns in this module
-> IdInfo -- see MkIface notes
-> Pretty
else pp_unfolding sty for_this_id inline_env unfold,
if specs_please
- then ppSpecs sty (not (isDataCon for_this_id))
- better_id_fn inline_env (mEnvToList specenv)
+ then pp_NONE -- 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
See SpecEnv.lhs
\begin{code}
-instance OptIdInfo (MatchEnv [Type] CoreExpr) where
- noInfo = nullMEnv
+instance OptIdInfo SpecEnv where
+ noInfo = nullSpecEnv
getInfo (IdInfo _ _ spec _ _ _ _ _ _ _) = spec
- addInfo id_info spec | null (mEnvToList spec) = id_info
+ addInfo id_info spec | isNullSpecEnv spec = id_info
addInfo (IdInfo a b _ d e f g h i j) spec = IdInfo a b spec d e f g h i j
- ppInfo sty better_id_fn spec
- = ppSpecs sty True better_id_fn nullIdEnv (mEnvToList spec)
-
-ppSpecs sty print_spec_id_info better_id_fn inline_env spec_env
- = if null spec_env then ppNil else panic "IdInfo:ppSpecs"
+ ppInfo sty better_id_fn spec = panic "IdInfo:ppSpecs"
+-- = ppSpecs sty True better_id_fn nullIdEnv (mEnvToList spec)
\end{code}
%************************************************************************
indicatesWorker :: [Demand] -> Bool
indicatesWorker dems
- = fake_mk_ww (_trace "mAX_WORKER_ARGS" 6 - nonAbsentArgs dems) dems
+ = fake_mk_ww (mAX_WORKER_ARGS - nonAbsentArgs dems) dems
where
fake_mk_ww _ [] = False
fake_mk_ww _ (WwLazy True : _) = True -- we accepted an Absent
\begin{code}
mkUnfolding guide expr
- = GenForm (mkFormSummary NoStrictnessInfo expr)
- (occurAnalyseGlobalExpr expr)
- guide
+ = CoreUnfolding (SimpleUnfolding (mkFormSummary expr)
+ guide
+ (occurAnalyseGlobalExpr expr))
\end{code}
\begin{code}
-noInfo_UF = NoUnfoldingDetails
-
-getInfo_UF (IdInfo _ _ _ _ unfolding _ _ _ _ _)
- = case unfolding of
- GenForm _ _ BadUnfolding -> NoUnfoldingDetails
- unfolding_as_was -> unfolding_as_was
+noInfo_UF = NoUnfolding
--- getInfo_UF ensures that any BadUnfoldings are never returned
--- We had to delay the test required in TcPragmas until now due
--- to strictness constraints in TcPragmas
+getInfo_UF (IdInfo _ _ _ _ unfolding _ _ _ _ _) = unfolding
-addInfo_UF id_info@(IdInfo a b c d e f g h i j) NoUnfoldingDetails = id_info
-addInfo_UF (IdInfo a b d e _ f g h i j) uf = IdInfo a b d e uf f g h i j
+addInfo_UF id_info@(IdInfo a b c d e f g h i j) NoUnfolding = id_info
+addInfo_UF (IdInfo a b d e _ f g h i j) uf = IdInfo a b d e uf f g h i j
\end{code}
\begin{code}
Nothing -> pp uf_details
Just dt -> pp dt
where
- pp NoUnfoldingDetails = pp_NONE
-
- pp (MagicForm tag _)
- = ppCat [ppPStr SLIT("_MF_"), ppPStr tag]
+ pp NoUnfolding = pp_NONE
- pp (GenForm _ _ BadUnfolding) = pp_NONE
+ pp (MagicUnfolding tag _)
+ = ppCat [ppPStr SLIT("_MF_"), pprUnique tag]
- pp (GenForm _ template guide)
+ pp (CoreUnfolding (SimpleUnfolding _ guide template))
= let
untagged = unTagBinders template
in
projects / ghc-hetmet.git / blobdiff